puppetresources 0.4.1 → 0.4.2
raw patch · 2 files changed
+81/−63 lines, 2 filesdep +textdep ~Diffdep ~hsfacterdep ~language-puppet
Dependencies added: text
Dependency ranges changed: Diff, hsfacter, language-puppet
Files
- Main.hs +73/−57
- puppetresources.cabal +8/−6
Main.hs view
@@ -103,7 +103,6 @@ import System.Environment import Data.List-import System.IO import qualified Data.Map as Map import Data.Algorithm.Diff import qualified System.Log.Logger as LOG@@ -112,6 +111,10 @@ import Control.Monad.Error (runErrorT) import Data.Char (toLower) import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Monoid hiding (First)+import Data.Maybe (isNothing) import Facter @@ -123,11 +126,15 @@ import Puppet.DSL.Printer import Puppet.DSL.Loader import Puppet.JsonCatalog+import PuppetDB.Rest +tshow :: Show a => a -> T.Text+tshow = T.pack . show+ usage = error "Usage: puppetresource puppetdir nodename [filename]" addRequire :: FinalCatalog -> ((ResIdentifier, ResIdentifier), LinkInfo) -> FinalCatalog-addRequire curcat ((src, dst), (ltype, _, _)) =+addRequire curcat ((src, dst), (ltype, _, _, _)) = case Map.lookup src curcat of Nothing -> curcat Just res -> Map.insert src (res { rrelations = (ltype, dst) : rrelations res }) curcat@@ -137,38 +144,50 @@ hackish as it will generate facts from the local computer ! -} -initializedaemonWithPuppet :: Maybe String -> String -> IO ([Char] -> IO (FinalCatalog, EdgeMap, FinalCatalog))+initializedaemonWithPuppet :: Maybe T.Text -> T.Text -> IO (T.Text -> IO (FinalCatalog, EdgeMap, FinalCatalog)) initializedaemonWithPuppet purl puppetdir = do LOG.updateGlobalLogger "Puppet.Daemon" (LOG.setLevel LOG.WARNING) prefs <- genPrefs puppetdir- (queryfunc, _, _, _) <- initDaemon (prefs { puppetDBurl = purl })+ let nprefs = case purl of+ Nothing -> prefs+ Just ur -> prefs { puppetDBquery = pdbRequest ur }+ queryfunc <- if isNothing purl+ then testingDaemon Nothing puppetdir allFacts+ else do+ (q, _, _, _) <- initDaemon nprefs+ return (\nodename -> allFacts nodename >>= q nodename) return (\nodename -> do- o <- allFacts nodename >>= queryfunc nodename+ o <- queryfunc nodename case o of Left err -> error err- Right (c,m,e) -> do- return $ (foldl' addRequire c (Map.toList m), m, e)+ Right (c,m,e) -> return (foldl' addRequire c (Map.toList m), m, e) ) {-| A helper for when you don't want to use PuppetDB -}-initializedaemon :: String -> IO ([Char] -> IO (FinalCatalog, EdgeMap, FinalCatalog))+initializedaemon :: T.Text -> IO (T.Text -> IO (FinalCatalog, EdgeMap, FinalCatalog)) initializedaemon = initializedaemonWithPuppet Nothing -showparam (k,v) = k ++ " => " ++ show v+showparam :: (T.Text, ResolvedValue) -> T.Text+showparam (k,v) = k <> " => " <> tshow v -showtdiff :: (DI, String) -> String-showtdiff (F, s) = "- " ++ s-showtdiff (S, s) = "+ " ++ s+showtdiff :: Diff T.Text -> T.Text+showtdiff (First s) = "- " <> s+showtdiff (Second s) = "+ " <> s+showtdiff (Both _ _) = "" -textdiff :: ResolvedValue -> ResolvedValue -> [String]-textdiff (ResolvedString s1) (ResolvedString s2) = map showtdiff $ filter (\(x,_) -> x /= B) $ getDiff (lines s1) (lines s2)+textdiff :: ResolvedValue -> ResolvedValue -> [T.Text]+textdiff (ResolvedString s1) (ResolvedString s2) = map showtdiff $ filter (not . isBoth) $ getDiff (T.lines s1) (T.lines s2)+ where+ isBoth Both{} = True+ isBoth _ = False+textdiff a b = error ("hum? " ++ show a ++ " " ++ show b) -showpdiff :: String -> ResolvedValue -> ResolvedValue -> [String]+showpdiff :: T.Text -> ResolvedValue -> ResolvedValue -> [T.Text] showpdiff pname pval1 pval2- | pname == "content" = ["# content\n"] ++ textdiff pval1 pval2- | otherwise = ["- " ++ showparam (pname, pval1), "+ " ++ showparam (pname, pval2)]+ | pname == "content" = "# content\n" : textdiff pval1 pval2+ | otherwise = ["- " <> showparam (pname, pval1), "+ " <> showparam (pname, pval2)] -paramdiff :: Map.Map String ResolvedValue -> String -> ResolvedValue -> [String] -> [String]+paramdiff :: Map.Map T.Text ResolvedValue -> T.Text -> ResolvedValue -> [T.Text] -> [T.Text] paramdiff lpmap rpname rpval curdiff = curdiff ++ newdiff where mlpval = Map.lookup rpname lpmap@@ -179,8 +198,8 @@ then [] else showpdiff rpname lpval rpval -getdiff :: ResIdentifier -> RResource -> RResource -> String-getdiff (rtype,rname) r1 r2 = rtype ++ "[" ++ rname ++ "]" ++ " {\n" ++ (concatMap (\x -> x ++"\n") difflist) ++ "}"+getdiff :: ResIdentifier -> RResource -> RResource -> T.Text+getdiff (rtype,rname) r1 r2 = rtype <> "[" <> rname <> "] {\n" <> T.intercalate "\n" difflist <> "\n}" where difflist = diffrelations ++ diffparams diffrelations = []@@ -188,15 +207,15 @@ p2 = rrparams r2 onlyleft = Map.difference p1 p2 onlyright = Map.difference p2 p1- diffparams = ol ++ or ++ distincts- ol = map (\x -> "- " ++ showparam x) $ Map.toList onlyleft- or = map (\x -> "+ " ++ showparam x) $ Map.toList onlyright+ diffparams = ole ++ ori ++ distincts+ ole = map (\x -> "- " <> showparam x) $ Map.toList onlyleft+ ori = map (\x -> "+ " <> showparam x) $ Map.toList onlyright distincts = Map.foldrWithKey (paramdiff p1) [] p2 rescompare :: RResource -> RResource -> Bool-rescompare (RResource _ a1 b1 c1 d1 _) (RResource _ a2 b2 c2 d2 _) = (a1==a2) && (b1==b2) && (c1==c2) && (d1==d2)+rescompare (RResource _ a1 b1 c1 d1 _ _) (RResource _ a2 b2 c2 d2 _ _) = (a1==a2) && (b1==b2) && (c1==c2) && (d1==d2) -checkdiff :: FinalCatalog -> ResIdentifier -> RResource -> (FinalCatalog, [String]) -> (FinalCatalog, [String])+checkdiff :: FinalCatalog -> ResIdentifier -> RResource -> (FinalCatalog, [T.Text]) -> (FinalCatalog, [T.Text]) checkdiff refmap resid res (curseconds, curdiffs) = (newseconds, newdiffs) where myres = Map.lookup resid refmap@@ -208,7 +227,7 @@ Just x -> if rescompare x res then curdiffs- else (getdiff resid x res) : curdiffs+ else getdiff resid x res : curdiffs {-| The diffing function, will output what is only in the first catalog, then what is only in the second, and will end with a diff between common resources.@@ -219,13 +238,9 @@ diff c1 c2 = do let onlyfirsts = Map.difference c1 c2 (onlyseconds, differences) = Map.foldrWithKey (checkdiff c1) (Map.empty, []) c2- if Map.null onlyfirsts- then return ()- else putStrLn $ "Only in the first catalog:\n" ++ showFCatalog onlyfirsts- if Map.null onlyseconds- then return ()- else putStrLn $ "Only in the second catalog:\n" ++ showFCatalog onlyseconds- mapM_ putStrLn differences+ unless (Map.null onlyfirsts) $ T.putStrLn $ "Only in the first catalog:\n" <> showFCatalog onlyfirsts+ unless (Map.null onlyseconds) $ T.putStrLn $ "Only in the second catalog:\n" <> showFCatalog onlyseconds+ mapM_ T.putStrLn differences doparse :: FilePath -> IO () doparse fp = do@@ -236,66 +251,67 @@ exitWith ExitSuccess -- prints the content of a file-printContent :: String -> FinalCatalog -> IO ()+printContent :: T.Text -> FinalCatalog -> IO () printContent filename catalog =- case (Map.lookup ("file", filename) catalog) of+ case Map.lookup ("file", filename) catalog of Nothing -> error "File not found"- Just r -> case (Map.lookup "content" (rrparams r)) of+ Just r -> case Map.lookup "content" (rrparams r) of Nothing -> error "This file has no content"- Just (ResolvedString c) -> putStrLn c+ Just (ResolvedString c) -> T.putStrLn c Just x -> print x -- pretty print a resource -- if this resource has content, works like printContent-printResource :: String -> String -> FinalCatalog -> IO ()+printResource :: T.Text -> T.Text -> FinalCatalog -> IO () printResource restype resname catalog =- case (Map.lookup (restype, resname) catalog) of- Nothing -> error $ "Resource " ++ restype ++ "[" ++ resname ++ "] does not exists."- Just r -> putStrLn $ showFCatalog $ Map.singleton (restype, resname) r+ case Map.lookup (restype, resname) catalog of+ Nothing -> error $ T.unpack $ "Resource " <> restype <> "[" <> resname <> "] does not exists."+ Just r -> T.putStrLn $ showFCatalog $ Map.singleton (restype, resname) r -r2s :: ResolvedValue -> String+r2s :: ResolvedValue -> T.Text r2s (ResolvedString x) = x-r2s x = show x+r2s x = tshow x -- filters resources by type name-getResourcesOfType :: String -> FinalCatalog -> FinalCatalog+getResourcesOfType :: T.Text -> FinalCatalog -> FinalCatalog getResourcesOfType rtype = Map.filter (\r -> rrtype r == rtype) -- just extract the names of the resources-getResourceNames :: FinalCatalog -> [String]+getResourceNames :: FinalCatalog -> [T.Text] getResourceNames cat = map snd $ Map.keys cat main :: IO () main = do- args <- getArgs+ args <- fmap (map T.pack) getArgs let (rargs, puppeturl) = case args of ("-r":pu:xs) -> (xs, Just pu) _ -> (args, Nothing)- when (length rargs == 1) (doparse (head rargs))+ when (length rargs == 1) (doparse (T.unpack $ head rargs)) let (puppetdir, nodename) | (length rargs /= 2) && (length rargs /= 3) = usage | otherwise = (rargs !! 0, rargs !! 1)- getresname :: String -> Maybe (String, String)+ getresname :: T.Text -> Maybe (T.Text, T.Text) getresname r =- let isresname = ((head $ reverse r) == ']') && ('[' `elem` r)- (rtype, rname) = break (== '[') r+ let isresname = T.last r == ']' && T.isInfixOf "[" r+ (rtype, rname) = T.break (== '[') r in if isresname- then Just (map toLower rtype, tail $ reverse $ (tail $ reverse rname))+ then Just (T.map toLower rtype, T.tail $ T.init rname) else Nothing handlePrintResource resname cat- = case (getresname resname) of+ = case getresname resname of Just (t,n) -> printResource t n cat Nothing -> printContent resname cat queryfunc <- initializedaemonWithPuppet puppeturl puppetdir (x,m,e) <- queryfunc nodename- tests <- testCatalog puppetdir x []- case tests of- Right _ -> return ()- Left rr -> error rr if length rargs == 3 then if (rargs !! 2) == "JSON" then do let json = catalog2JSon nodename 1 x e m BSL.putStrLn json else handlePrintResource (rargs !! 2) x- else putStrLn $ showFCatalog x+ else do+ (tests,_) <- testCatalog puppetdir x []+ case tests of+ Right _ -> return ()+ Left rr -> error rr+ T.putStrLn $ showFCatalog x
puppetresources.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: puppetresources-version: 0.4.1+version: 0.4.2 synopsis: A program that displays the puppet resources associated to a node given .pp files. -- description: license: GPL-3@@ -22,13 +22,15 @@ executable puppetresources extensions: BangPatterns main-is: Main.hs- ghc-options: -rtsopts+ ghc-options: -rtsopts -Wall -O2+ extensions: OverloadedStrings -- other-modules: build-depends: base >=3 && <5,- language-puppet >= 0.3.1.0,- hsfacter >= 0.2.0.0,+ language-puppet >= 0.4.0,+ hsfacter >= 0.2.1, containers, hslogger,- Diff,+ Diff >= 0.2.0, mtl,- bytestring+ bytestring,+ text