Add descriptions of how to set missing fields to --list-fields output. (Minor API changes)

debian/changelog

@@ -1,3 +1,10 @@
+propellor (1.4.0) UNRELEASED; urgency=medium
+
+  * Add descriptions of how to set missing fields to --list-fields output.
+    (Minor API changes)
+
+ -- Joey Hess <id@joeyh.name>  Thu, 15 Jan 2015 20:14:29 -0400
+
 propellor (1.3.2) unstable; urgency=medium
 
   * SSHFP records are also generated for CNAMES of hosts.

src/Propellor/Host.hs

@@ -61,4 +61,4 @@ propigateInfo hl p f = combineProperties (propertyDesc p) $
 	p' = p { propertyInfo = f (propertyInfo p) }
 	i = hostInfo (getHost hl)
 	dnsprops = map addDNS (S.toList $ _dns i)
-	privprops = map addPrivDataField (S.toList $ _privDataFields i)
+	privprops = map addPrivData (S.toList $ _privData i)

src/Propellor/PrivData.hs

@@ -82,20 +82,24 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 		Context cname <- mkHostContext hc <$> asks hostName
 		warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")"
 		liftIO $ putStrLn $ "Fix this by running:"
-		liftIO $ forM_ srclist $ \src -> do
+		liftIO $ showSet $
-			putStrLn $ "  propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "' \\"
+			map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist
-			maybe noop (\d -> putStrLn $ "    " ++ d) (describePrivDataSource src)
-			putStrLn ""
 		return FailedChange
-	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = fieldset } }
+	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privData = privset } }
+	privset = S.fromList $ map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
-	fieldset = S.fromList $ zip fieldlist (repeat hc)
 	fieldlist = map privDataField srclist
 	hc = asHostContext c
 
-addPrivDataField :: (PrivDataField, HostContext) -> Property
+showSet :: [(PrivDataField, Context, Maybe PrivDataSourceDesc)] -> IO ()
-addPrivDataField v = pureInfoProperty (show v) $
+showSet l = forM_ l $ \(f, Context c, md) -> do
-	mempty { _privDataFields = S.singleton v }
+	putStrLn $ "  propellor --set '" ++ show f ++ "' '" ++ c ++ "' \\"
+	maybe noop (\d -> putStrLn $ "    " ++ d) md
+	putStrLn ""
+
+addPrivData :: (PrivDataField, Maybe PrivDataSourceDesc, HostContext) -> Property
+addPrivData v = pureInfoProperty (show v) $
+	mempty { _privData = S.singleton v }
 
 {- Gets the requested field's value, in the specified context if it's
  - available, from the host's local privdata cache. -}
@@ -111,8 +115,8 @@ type PrivMap = M.Map (PrivDataField, Context) PrivData
 filterPrivData :: Host -> PrivMap -> PrivMap
 filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
   where
-	used = S.map (\(f, c) -> (f, mkHostContext c (hostName host))) $
+	used = S.map (\(f, _, c) -> (f, mkHostContext c (hostName host))) $
-		_privDataFields $ hostInfo host
+		_privData $ hostInfo host
 
 getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
 getPrivData field context = M.lookup (field, context)
@@ -142,10 +146,17 @@ editPrivData field context = do
 listPrivDataFields :: [Host] -> IO ()
 listPrivDataFields hosts = do
 	m <- decryptPrivData
-	showtable "Currently set data:" $
+	
-		map mkrow (M.keys m)
+	section "Currently set data:"
-	showtable "Data that would be used if set:" $
+	showtable $ map mkrow (M.keys m)
-		map mkrow (M.keys $ M.difference wantedmap m)
+	let missing = M.keys $ M.difference wantedmap m
+	
+	unless (null missing) $ do
+		section "Missing data that would be used if set:"
+		showtable $ map mkrow missing
+
+		section "How to set missing data:"
+		showSet $ map (\(f, c) -> (f, c, join $ M.lookup (f, c) descmap)) missing
   where
 	header = ["Field", "Context", "Used by"]
 	mkrow k@(field, (Context context)) =
@@ -153,12 +164,13 @@ listPrivDataFields hosts = do
 		, shellEscape context
 		, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
 		]
-	mkhostmap host = M.fromList $ map (\(f, c) -> ((f, mkHostContext c (hostName host)), [hostName host])) $
+	mkhostmap host mkv = M.fromList $ map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d)) $
-		S.toList $ _privDataFields $ hostInfo host
+		S.toList $ _privData $ hostInfo host
-	usedby = M.unionsWith (++) $ map mkhostmap hosts
+	usedby = M.unionsWith (++) $ map (\h -> mkhostmap h $ const $ [hostName h]) hosts
 	wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
-	showtable desc rows = do
+	descmap = M.unions $ map (\h -> mkhostmap h id) hosts
-		putStrLn $ "\n" ++ desc
+	section desc = putStrLn $ "\n" ++ desc
+	showtable rows = do
 		putStr $ unlines $ formatTable $ tableWithHeader header rows
 
 setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()

src/Propellor/Types.hs

@@ -176,7 +176,7 @@ data CmdLine
 -- | Information about a host.
 data Info = Info
 	{ _os :: Val System
-	, _privDataFields :: S.Set (PrivDataField, HostContext)
+	, _privData :: S.Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext)
 	, _sshPubKey :: M.Map SshKeyType String
 	, _aliases :: S.Set HostName
 	, _dns :: S.Set Dns.Record
@@ -190,7 +190,7 @@ instance Monoid Info where
 	mempty = Info mempty mempty mempty mempty mempty mempty mempty mempty
 	mappend old new = Info
 		{ _os = _os old <> _os new
-		, _privDataFields = _privDataFields old <> _privDataFields new
+		, _privData = _privData old <> _privData new
 		, _sshPubKey = _sshPubKey new `M.union` _sshPubKey old
 		, _aliases = _aliases old <> _aliases new
 		, _dns = _dns old <> _dns new
@@ -202,7 +202,7 @@ instance Monoid Info where
 instance Empty Info where
 	isEmpty i = and
 		[ isEmpty (_os i)
-		, isEmpty (_privDataFields i)
+		, isEmpty (_privData i)
 		, isEmpty (_sshPubKey i)
 		, isEmpty (_aliases i)
 		, isEmpty (_dns i)

src/Propellor/Types/PrivData.hs

@@ -24,9 +24,11 @@ data PrivDataSource
 	| PrivDataSourceFileFromCommand PrivDataField FilePath String
 	| PrivDataSource PrivDataField String
 
+type PrivDataSourceDesc = String
+
 class IsPrivDataSource s where
 	privDataField :: s -> PrivDataField
-	describePrivDataSource :: s -> Maybe String
+	describePrivDataSource :: s -> Maybe PrivDataSourceDesc
 
 instance IsPrivDataSource PrivDataField where
 	privDataField = id