diff --git a/Facter.hs b/Facter.hs --- a/Facter.hs +++ b/Facter.hs @@ -13,8 +13,9 @@ import System.Posix.User import System.Posix.Unistd (getSystemID, SystemID(..)) import Data.List.Split (splitOn) -import Data.List (intercalate) +import Data.List (intercalate,stripPrefix) import System.Environment +import Data.Maybe (mapMaybe) storageunits :: [(String, Int)] storageunits = [ ("", 0), ("K", 1), ("M", 2), ("G", 3), ("T", 4) ] @@ -53,6 +54,7 @@ swaptotal = ginfo "SwapTotal:" ginfo st = sdesc $ head $ filter ((== st) . head) meminfo sdesc [_, size, unit] = storagedesc (size, unit) + sdesc _ = storagedesc ("1","B") return [("memorysize", memtotal), ("memoryfree", memfree), ("swapfree", swapfree), ("swapsize", swaptotal)] factNET :: IO [(String, String)] @@ -123,12 +125,19 @@ path <- getEnv "PATH" return [ ("path", path) ] +factProcessor :: IO [(String,String)] +factProcessor = do + cpuinfo <- readFile "/proc/cpuinfo" + let cpuinfos = zip [ "processor" ++ show (n :: Int) | n <- [0..]] modelnames + modelnames = mapMaybe (fmap (dropWhile (`elem` "\t :")) . stripPrefix "model name") (lines cpuinfo) + return $ ("processorcount", show (length cpuinfos)) : cpuinfos + puppetDBFacts :: T.Text -> PuppetDBAPI -> IO (Container T.Text) puppetDBFacts ndename pdbapi = getFacts pdbapi (QEqual FCertname ndename) >>= \case S.Right facts@(_:_) -> return (HM.fromList (map (\f -> (f ^. factname, f ^. factval)) facts)) _ -> do - rawFacts <- fmap concat (sequence [factNET, factRAM, factOS, fversion, factMountPoints, factOS, factUser, factUName, fenv]) + rawFacts <- fmap concat (sequence [factNET, factRAM, factOS, fversion, factMountPoints, factOS, factUser, factUName, fenv, factProcessor]) let ofacts = genFacts $ map (T.pack *** T.pack) rawFacts (hostname, ddomainname) = T.break (== '.') ndename domainname = if T.null ddomainname diff --git a/Puppet/Daemon.hs b/Puppet/Daemon.hs --- a/Puppet/Daemon.hs +++ b/Puppet/Daemon.hs @@ -107,7 +107,7 @@ -> HieraQueryFunc -> T.Text -> Facts - -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog)) + -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) gCatalog prefs getStatements getTemplate stats hquery ndename facts = do logDebug ("Received query for node " <> ndename) traceEventIO ("Received query for node " <> T.unpack ndename) diff --git a/Puppet/Interpreter.hs b/Puppet/Interpreter.hs --- a/Puppet/Interpreter.hs +++ b/Puppet/Interpreter.hs @@ -34,6 +34,12 @@ vmapM :: (Monad m, Foldable t) => (a -> m b) -> t a -> m [b] vmapM f = mapM f . toList +-- | This is the main function for computing catalogs. It returns the +-- result of the compulation (either an error, or a tuple containing all +-- the resources, dependency map, exported resources, and defined resources +-- (this last one might not be up to date and is only useful for code +-- coverage tests)) along with all messages that have been generated by the +-- compilation process. getCatalog :: ( TopLevelType -> T.Text -> IO (S.Either Doc Statement) ) -- ^ get statements function -> (Either T.Text T.Text -> T.Text -> Container ScopeInformation -> IO (S.Either Doc T.Text)) -- ^ compute template function -> PuppetDBAPI @@ -42,7 +48,7 @@ -> Container PuppetTypeMethods -- ^ List of native types -> Container ( [PValue] -> InterpreterMonad PValue ) -> HieraQueryFunc -- ^ Hiera query function - -> IO (Pair (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog)) [Pair Priority Doc]) + -> IO (Pair (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) [Pair Priority Doc]) getCatalog gtStatement gtTemplate pdbQuery ndename facts nTypes extfuncs hquery = do let rdr = InterpreterReader nTypes gtStatement gtTemplate pdbQuery extfuncs ndename hquery dummypos = initialPPos "dummy" @@ -58,7 +64,7 @@ isParent _ (ContImport _ _) = return False -- no relationship through import isParent _ ContRoot = return False isParent _ (ContImported _) = return False -isParent _ (ContDefine _ _) = return False +isParent _ (ContDefine _ _ _) = return False isParent cur (ContClass possibleparent) = do preuse (scopes . ix cur . scopeParent) >>= \case Nothing -> throwPosError ("Internal error: could not find scope" <+> ttext cur <+> "possible parent" <+> ttext possibleparent) @@ -146,7 +152,7 @@ S.Right x -> evalTopLevel x S.Left y -> throwPosError y -computeCatalog :: T.Text -> InterpreterMonad (FinalCatalog, EdgeMap, FinalCatalog) +computeCatalog :: T.Text -> InterpreterMonad (FinalCatalog, EdgeMap, FinalCatalog, [Resource]) computeCatalog ndename = do (restop, node) <- getstt TopNode ndename let finalStep [] = return [] @@ -174,7 +180,8 @@ _ -> curr :!: cure verified <- fmap (ifromList . map (\r -> (r ^. rid, r))) $ mapM validateNativeType (toList real) mp <- makeEdgeMap verified - return (verified, mp, exported) + definedRes <- use definedResources + return (verified, mp, exported, HM.elems definedRes) dependencyErrors :: [T.Tree G.Vertex] -> (G.Vertex -> (RIdentifier, RIdentifier, [RIdentifier])) -> InterpreterMonad () dependencyErrors _ _ = throwPosError "Undefined dependency cycle" @@ -200,11 +207,11 @@ let containerMap :: HM.HashMap RIdentifier [RIdentifier] !containerMap = ifromListWith (<>) $ do r <- toList ct - let toResource ContRoot = return $ RIdentifier "class" "::" - toResource (ContClass cn) = return $ RIdentifier "class" cn - toResource (ContDefine t n) = return $ RIdentifier t n - toResource (ContImported _) = mzero - toResource (ContImport _ _) = mzero + let toResource ContRoot = return $ RIdentifier "class" "::" + toResource (ContClass cn) = return $ RIdentifier "class" cn + toResource (ContDefine t n _) = return $ RIdentifier t n + toResource (ContImported _) = mzero + toResource (ContImport _ _) = mzero o <- toResource (rcurcontainer r) return (o, [r ^. rid]) -- This function uses the previous map in order to resolve to non @@ -539,7 +546,7 @@ modulename = case T.splitOn "::" deftype of [] -> deftype (x:_) -> x - let curContType = ContDefine deftype defname + let curContType = ContDefine deftype defname (r ^. rpos) p <- use curPos void $ enterScope SENormal curContType modulename p (spurious, dls) <- getstt TopDefine deftype @@ -676,11 +683,11 @@ let !defaulttags = {-# SCC "rrGetTags" #-} HS.fromList (rt : classtags) <> tgs allsegs x = x : T.splitOn "::" x !classtags = getClassTags cnt - getClassTags (ContClass cn ) = allsegs cn - getClassTags (ContDefine dt _) = allsegs dt - getClassTags (ContRoot ) = [] - getClassTags (ContImported _ ) = [] - getClassTags (ContImport _ _ ) = [] + getClassTags (ContClass cn ) = allsegs cn + getClassTags (ContDefine dt _ _) = allsegs dt + getClassTags (ContRoot ) = [] + getClassTags (ContImported _ ) = [] + getClassTags (ContImport _ _ ) = [] allScope <- use curScope fqdn <- view thisNodename let baseresource = Resource (RIdentifier rt rn) (HS.singleton rn) mempty mempty allScope vrt defaulttags p fqdn diff --git a/Puppet/Interpreter/PrettyPrinter.hs b/Puppet/Interpreter/PrettyPrinter.hs --- a/Puppet/Interpreter/PrettyPrinter.hs +++ b/Puppet/Interpreter/PrettyPrinter.hs @@ -90,7 +90,7 @@ pretty (ContImported x) = magenta "imported" <> braces (pretty x) pretty ContRoot = dullyellow (text "::") pretty (ContClass cname) = dullyellow (text "class") <+> dullgreen (text (T.unpack cname)) - pretty (ContDefine dtype dname) = pretty (PResourceReference dtype dname) + pretty (ContDefine dtype dname _) = pretty (PResourceReference dtype dname) instance Pretty ResDefaults where pretty (ResDefaults t _ v p) = capitalize t <+> showPPos p <$> containerComma v diff --git a/Puppet/Interpreter/Types.hs b/Puppet/Interpreter/Types.hs --- a/Puppet/Interpreter/Types.hs +++ b/Puppet/Interpreter/Types.hs @@ -109,7 +109,7 @@ data CurContainerDesc = ContRoot -- ^ Contained at node or root level | ContClass !T.Text -- ^ Contained in a class - | ContDefine !T.Text !T.Text -- ^ Contained in a define + | ContDefine !T.Text !T.Text !PPosition -- ^ Contained in a define, along with the position where this define was ... defined | ContImported !CurContainerDesc -- ^ Dummy container for imported resources, so that we know we must update the nodename | ContImport !Nodename !CurContainerDesc -- ^ This one is used when finalizing imported resources, and contains the current node name deriving (Eq, Generic, Ord) @@ -238,7 +238,7 @@ type FinalCatalog = HM.HashMap RIdentifier Resource -data DaemonMethods = DaemonMethods { _dGetCatalog :: T.Text -> Facts -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog)) +data DaemonMethods = DaemonMethods { _dGetCatalog :: T.Text -> Facts -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) -- ^ The most important function, computing catalogs. Given a node name and a list of facts, it returns the result of the catalog compilation : either an error, or a tuple containing all the resources in this catalog, the dependency map, the exported resources, and a list of known resources, that might not be up to date, but are here for code coverage tests. , _dParserStats :: MStats , _dCatalogStats :: MStats , _dTemplateStats :: MStats @@ -345,7 +345,7 @@ scopeName (ContRoot ) = "::" scopeName (ContImported x ) = "::imported::" `T.append` scopeName x scopeName (ContClass x ) = x -scopeName (ContDefine dt dn) = "#define/" `T.append` dt `T.append` "/" `T.append` dn +scopeName (ContDefine dt dn _) = "#define/" `T.append` dt `T.append` "/" `T.append` dn scopeName (ContImport _ x ) = "::import::" `T.append` scopeName x getScopeName :: InterpreterMonad T.Text diff --git a/Puppet/Lens.hs b/Puppet/Lens.hs --- a/Puppet/Lens.hs +++ b/Puppet/Lens.hs @@ -144,10 +144,12 @@ sget (DefineDeclaration _ _ s _) = s sget (Node _ s _ _) = s sget (TopContainer s _) = s + sget (SHFunctionCall (HFunctionCall _ _ _ s _) _) = s sget _ = V.empty sset :: Statement -> V.Vector Statement -> Statement sset (ClassDeclaration n args inh _ p) s = ClassDeclaration n args inh s p sset (Node ns _ nd' p) s = Node ns s nd' p sset (DefineDeclaration n args _ p) s = DefineDeclaration n args s p sset (TopContainer _ p) s = TopContainer s p + sset (SHFunctionCall (HFunctionCall t e pr _ e2) p) s = SHFunctionCall (HFunctionCall t e pr s e2) p sset x _ = x diff --git a/Puppet/Testing.hs b/Puppet/Testing.hs --- a/Puppet/Testing.hs +++ b/Puppet/Testing.hs @@ -110,7 +110,7 @@ testingDaemon :: PuppetDBAPI -- ^ Contains the puppetdb API functions -> FilePath -- ^ Path to the manifests -> (T.Text -> IO (Container T.Text)) -- ^ The facter function - -> IO (T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog))) + -> IO (T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog, [Resource]))) testingDaemon pdb pdir allFacts = do LOG.updateGlobalLogger "Puppet.Daemon" (LOG.setLevel LOG.WARNING) prefs <- genPreferences pdir @@ -118,7 +118,7 @@ return (\nodname -> allFacts nodname >>= _dGetCatalog q nodname) -- | A default testing daemon. -defaultDaemon :: FilePath -> IO (T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog))) +defaultDaemon :: FilePath -> IO (T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog, [Resource]))) defaultDaemon pdir = do pdb <- getDefaultDB PDBTest >>= \case S.Left x -> error (show x) diff --git a/language-puppet.cabal b/language-puppet.cabal --- a/language-puppet.cabal +++ b/language-puppet.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet -version: 0.12.0 +version: 0.12.1 synopsis: Tools to parse and evaluate the Puppet DSL. description: This is a set of tools that is supposed to fill all your Puppet needs : syntax checks, catalog compilation, PuppetDB queries, simulationg of complex interactions between nodes, Puppet master replacement, and more ! homepage: http://lpuppet.banquise.net/ @@ -100,7 +100,7 @@ , time == 1.4.* , filecache >= 0.2.5 && < 0.3 , regex-pcre-builtin >= 0.94.4 - , pcre-utils >= 0.1.0.1 && < 0.2 + , pcre-utils >= 0.1.2 && < 0.2 , process >= 1.1 && < 1.3 , iconv == 0.4.* , http-types == 0.8.* @@ -158,7 +158,7 @@ extensions: BangPatterns, OverloadedStrings ghc-options: -Wall -rtsopts -threaded -with-rtsopts "-A2M" ghc-prof-options: -auto-all -caf-all -fprof-auto - build-depends: language-puppet,base,text,parsec,vector,ansi-wl-pprint,bytestring,mtl,hslogger,Diff,unordered-containers,strict-base-types,optparse-applicative,regex-pcre-builtin,lens,aeson,yaml,parallel-io + build-depends: language-puppet,base,text,parsec,vector,ansi-wl-pprint,bytestring,mtl,hslogger,Diff,unordered-containers,strict-base-types,optparse-applicative,regex-pcre-builtin,lens,aeson,yaml,parallel-io,containers,Glob,hspec main-is: PuppetResources.hs executable pdbquery diff --git a/progs/PuppetResources.hs b/progs/PuppetResources.hs --- a/progs/PuppetResources.hs +++ b/progs/PuppetResources.hs @@ -104,6 +104,7 @@ import System.IO import qualified Data.HashMap.Strict as HM +import qualified Data.Set as Set import qualified System.Log.Logger as LOG import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T @@ -119,6 +120,13 @@ import Data.Aeson (encode) import Data.Yaml (decodeFileEither) import Control.Lens as L +import Control.Concurrent.ParallelIO (parallel) +import Data.Maybe (mapMaybe) +import qualified System.FilePath.Glob as G +import Data.Either (partitionEithers) +import Data.List (isInfixOf) +import qualified Test.Hspec.Runner as H +import System.Exit (exitFailure, exitSuccess) import Facter @@ -136,14 +144,12 @@ import PuppetDB.Common import Puppet.Testing hiding ((<$>)) import Puppet.Lens - -import Control.Concurrent.ParallelIO (parallel_) -import Data.Maybe (mapMaybe) +import Puppet.Stats tshow :: Show a => a -> T.Text tshow = T.pack . show -type QueryFunc = T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog)) +type QueryFunc = T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) checkErrorStrict :: S.Either Doc x -> IO x checkErrorStrict (S.Left rr) = putDoc rr >> putStrLn "" >> error "error!" @@ -154,13 +160,13 @@ hackish as it will generate facts from the local computer ! -} -initializedaemonWithPuppet :: LOG.Priority -> PuppetDBAPI -> FilePath -> Maybe FilePath -> (Facts -> Facts) -> IO QueryFunc +initializedaemonWithPuppet :: LOG.Priority -> PuppetDBAPI -> FilePath -> Maybe FilePath -> (Facts -> Facts) -> IO (QueryFunc, MStats, MStats, MStats) initializedaemonWithPuppet prio pdbapi puppetdir hierapath overrideFacts = do LOG.updateGlobalLogger "Puppet.Daemon" (LOG.setLevel prio) q <- fmap ((prefPDB .~ pdbapi) . (hieraPath .~ hierapath)) (genPreferences puppetdir) >>= initDaemon let f ndename = fmap overrideFacts (puppetDBFacts ndename pdbapi) >>= _dGetCatalog q ndename - return f + return (f, _dParserStats q, _dCatalogStats q, _dTemplateStats q) parseFile :: FilePath -> IO (Either P.ParseError (V.Vector Statement)) parseFile fp = T.readFile fp >>= runMyParser puppetParser fp @@ -252,7 +258,7 @@ <> help "Puppet directory") nn = strOption ( long "node" <> short 'o' - <> help "Node name. Using 'allnodes' enables a special mode where all nodes present in site.pp are tried. Run with +RTS -N") + <> help "Node name. Using 'allnodes' enables a special mode where all nodes present in site.pp are tried. Run with +RTS -N. Using 'deadcode' will do the same, but will print warnings about code that's not being used.") pdbfile = strOption ( long "pdbfile" <> help "Path to the testing PuppetDB file.") hiera = strOption ( long "hiera" @@ -283,6 +289,41 @@ isBool (PBoolean False) = Just "false" isBool _ = Nothing +-- this finds the dead code +findDeadCode :: String -> [Resource] -> Set.Set FilePath -> IO () +findDeadCode puppetdir catalogs allfiles = do + -- first collect all files / positions from all the catalogs + let allpositions = Set.fromList $ catalogs ^.. traverse . rpos + -- now find all haskell files + puppetfiles <- Set.fromList . concat . fst <$> G.globDir [G.compile "**/*.pp"] (puppetdir <> "/modules") + let deadfiles = Set.filter ("/manifests/" `isInfixOf`) $ puppetfiles `Set.difference` allfiles + usedfiles = puppetfiles `Set.intersection` allfiles + unless (Set.null deadfiles) $ do + putDoc ("The following files" <+> int (Set.size deadfiles) <+> "are not used: " <> list (map string $ Set.toList deadfiles)) + putStrLn "" + allparses <- parallel (map parseFile (Set.toList usedfiles)) + let (parseFailed, parseSucceeded) = partitionEithers allparses + unless (null parseFailed) $ do + putDoc ("The following" <+> int (length parseFailed) <+> "files could not be parsed:" indent 4 (vcat (map (string . show) parseFailed))) + putStrLn "" + let getSubStatements s@(ResourceDeclaration{}) = [s] + getSubStatements (ConditionalStatement conds _) = conds ^.. traverse . _2 . tgt + getSubStatements s@(ClassDeclaration{}) = extractPrism s + getSubStatements s@(DefineDeclaration{}) = extractPrism s + getSubStatements s@(Node{}) = extractPrism s + getSubStatements s@(SHFunctionCall{}) = extractPrism s + getSubStatements (TopContainer v s) = getSubStatements s ++ v ^.. tgt + getSubStatements _ = [] + tgt = folded . to getSubStatements . folded + extractPrism s = s ^.. _Statements . traverse . to getSubStatements . traverse + allResources = parseSucceeded ^.. folded . folded . to getSubStatements . folded + deadResources = filter isDead allResources + isDead (ResourceDeclaration _ _ _ _ pp) = not $ Set.member pp allpositions + isDead _ = True + unless (null deadResources) $ do + putDoc ("The following" <+> int (length deadResources) <+> "resource declarations are not used:" indent 4 (vcat (map pretty deadResources))) + putStrLn "" + run :: CommandLine -> IO () run (CommandLine _ _ _ _ _ f Nothing _ _ _ _ _) = parseFile f >>= \case Left rr -> error ("parse error:" ++ show rr) @@ -301,12 +342,14 @@ (Just p, Nothing) -> HM.union `fmap` loadFactsOverrides p (Nothing, Just p) -> (flip HM.union) `fmap` loadFactsOverrides p (Nothing, Nothing) -> return id - queryfunc <- initializedaemonWithPuppet prio pdbapi puppetdir hpath factsOverrides + (queryfunc,mPStats,_,_) <- initializedaemonWithPuppet prio pdbapi puppetdir hpath factsOverrides printFunc <- hIsTerminalDevice stdout >>= \isterm -> return $ \x -> if isterm then putDoc x >> putStrLn "" else displayIO stdout (renderCompact x) >> putStrLn "" - if tnodename == "allnodes" + let allnodes = tnodename == "allnodes" || deadcode + deadcode = tnodename == "deadcode" + exit <- if allnodes then do allstmts <- parseFile (puppetdir <> "/manifests/site.pp") >>= \presult -> case presult of Left rr -> error (show rr) @@ -314,17 +357,38 @@ let topnodes = mapMaybe getNodeName (V.toList allstmts) getNodeName (Node (NodeName n) _ _ _) = Just n getNodeName _ = Nothing - parallel_ (map (computeCatalogs True queryfunc pdbapi printFunc c) topnodes) + cats <- parallel (map (computeCatalogs True queryfunc pdbapi printFunc c) topnodes) putStrLn ("Tested " ++ show (length topnodes) ++ " nodes.") - else computeCatalogs False queryfunc pdbapi printFunc c tnodename + -- the the parsing statistics, so that we known which files + -- were parsed + pStats <- getStats mPStats + -- merge all the resources together + let cc = mapMaybe fst cats + testFailures = getSum (cats ^. traverse . _2 . _Just . to (Sum . H.summaryFailures)) + allres = (cc ^.. folded . _1 . folded) ++ (cc ^.. folded . _2 . folded) + allfiles = Set.fromList $ map T.unpack $ HM.keys pStats + when deadcode $ findDeadCode puppetdir allres allfiles + return $ if testFailures > 0 + then exitFailure + else exitSuccess + else do + r <- computeCatalogs False queryfunc pdbapi printFunc c tnodename + return $ case snd r of + Just s -> if (H.summaryFailures s > 0) + then exitFailure + else exitSuccess + Nothing -> exitSuccess void $ commitDB pdbapi + exit -computeCatalogs :: Bool -> QueryFunc -> PuppetDBAPI -> (Doc -> IO ()) -> CommandLine -> T.Text -> IO () +computeCatalogs :: Bool -> QueryFunc -> PuppetDBAPI -> (Doc -> IO ()) -> CommandLine -> T.Text -> IO (Maybe (FinalCatalog, [Resource]), Maybe H.Summary) computeCatalogs testOnly queryfunc pdbapi printFunc (CommandLine _ showjson showcontent mrt mrn puppetdir _ _ _ _ _ _) tnodename = queryfunc tnodename >>= \case - S.Left rr -> if testOnly - then putDoc ("Problem with" <+> ttext tnodename <+> ":" <+> rr mempty) - else putDoc rr >> putStrLn "" >> error "error!" - S.Right (rawcatalog,m,rawexported) -> do + S.Left rr -> do + if testOnly + then putDoc ("Problem with" <+> ttext tnodename <+> ":" <+> rr mempty) + else putDoc rr >> putStrLn "" >> error "error!" + return (Nothing, Just (H.Summary 1 1)) + S.Right (rawcatalog,m,rawexported,knownRes) -> do let wireCatalog = generateWireCatalog tnodename (rawcatalog <> rawexported) m void $ replaceCatalog pdbapi wireCatalog let cmpMatch Nothing _ curcat = return curcat @@ -336,23 +400,26 @@ Right Nothing -> return False _ -> return True filterCatalog = cmpMatch mrt (_1 . itype . unpacked) >=> cmpMatch mrn (_1 . iname . unpacked) - case (testOnly, showcontent, showjson) of - (True, _, _) -> void $ testCatalog tnodename puppetdir rawcatalog basicTest - (_, _, True) -> BSL.putStrLn (encode (prepareForPuppetApply wireCatalog)) + testResult <- case (testOnly, showcontent, showjson) of + (True, _, _) -> Just `fmap` testCatalog tnodename puppetdir rawcatalog basicTest + (_, _, True) -> BSL.putStrLn (encode (prepareForPuppetApply wireCatalog)) >> return Nothing (_, True, _) -> do catalog <- filterCatalog rawcatalog unless (mrt == Just "file" || mrt == Nothing) (error $ "Show content only works for file, not for " ++ show mrt) case mrn of Just f -> printContent f catalog Nothing -> error "You should supply a resource name when using showcontent" + return Nothing _ -> do catalog <- filterCatalog rawcatalog exported <- filterCatalog rawexported - void $ testCatalog tnodename puppetdir rawcatalog basicTest + r <- testCatalog tnodename puppetdir rawcatalog basicTest printFunc (pretty (HM.elems catalog)) unless (HM.null exported) $ do printFunc (mempty <+> dullyellow "Exported:" <+> mempty) printFunc (pretty (HM.elems exported)) + return (Just r) + return (Just (rawcatalog <> rawexported, knownRes), testResult) main :: IO () main = execParser pinfo >>= run