diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,11 @@ +# v1.1.3 (2015/05/31) + +## New features +* Support for the `$settings` variables. +* Support for the `to_yaml` function in templates. +* Settings can now be altered in the default YAML file. +* Defaults and overriden facts are now controlled in the YAML file too. + # v1.1.1.2 (2015/04/28) Various packaging changes. diff --git a/Puppet/Daemon.hs b/Puppet/Daemon.hs --- a/Puppet/Daemon.hs +++ b/Puppet/Daemon.hs @@ -110,6 +110,7 @@ (prefs ^. strictness == Strict)) ndename facts + (prefs^.puppetSettings) (stmts :!: warnings) <- measure stats ndename catalogComputation mapM_ (\(p :!: m) -> LOG.logM loggerName p (displayS (renderCompact (ttext ndename <> ":" <+> m)) "")) warnings traceEventIO ("STOP gCatalog " <> T.unpack ndename) diff --git a/Puppet/Interpreter.hs b/Puppet/Interpreter.hs --- a/Puppet/Interpreter.hs +++ b/Puppet/Interpreter.hs @@ -67,9 +67,10 @@ => InterpreterReader m -- ^ The whole environment required for computing catalog. -> Nodename -> Facts + -> Container T.Text -- ^ Server settings -> m (Pair (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) [Pair Priority Doc]) -getCatalog interpretReader node facts = do - (output, _, warnings) <- interpretMonad interpretReader (initialState facts) (computeCatalog node) +getCatalog interpretReader node facts settings = do + (output, _, warnings) <- interpretMonad interpretReader (initialState facts settings) (computeCatalog node) return (strictifyEither output :!: warnings) isParent :: T.Text -> CurContainerDesc -> InterpreterMonad Bool diff --git a/Puppet/Interpreter/Pure.hs b/Puppet/Interpreter/Pure.hs --- a/Puppet/Interpreter/Pure.hs +++ b/Puppet/Interpreter/Pure.hs @@ -53,7 +53,8 @@ -> (Either PrettyError a, InterpreterState, InterpreterWriter) pureEval facts sttmap action = runIdentity (interpretMonad (pureReader sttmap) startingState action) where - startingState = initialState facts + startingState = initialState facts $ HM.fromList [ ("confdir", "/etc/puppet") + ] -- | A bunch of facts that can be used for pure evaluation. diff --git a/Puppet/Interpreter/Types.hs b/Puppet/Interpreter/Types.hs --- a/Puppet/Interpreter/Types.hs +++ b/Puppet/Interpreter/Types.hs @@ -849,12 +849,17 @@ _ -> Left p toNumber p = Left p -initialState :: Facts -> InterpreterState -initialState facts = InterpreterState baseVars initialclass mempty [ContRoot] dummypos mempty [] [] +initialState :: Facts + -> Container T.Text -- ^ Server settings + -> InterpreterState +initialState facts settings = InterpreterState baseVars initialclass mempty [ContRoot] dummypos mempty [] [] where callervars = HM.fromList [("caller_module_name", PString "::" :!: dummypos :!: ContRoot), ("module_name", PString "::" :!: dummypos :!: ContRoot)] - factvars = facts & each %~ (\x -> x :!: initialPPos "facts" :!: ContRoot) - baseVars = HM.singleton "::" (ScopeInformation (factvars `mappend` callervars) mempty mempty (CurContainer ContRoot mempty) mempty S.Nothing) + factvars = fmap (\x -> x :!: initialPPos "facts" :!: ContRoot) facts + settingvars = fmap (\x -> PString x :!: initialPPos "settings" :!: ContClass "settings") settings + baseVars = HM.fromList [ ("::", ScopeInformation (factvars `mappend` callervars) mempty mempty (CurContainer ContRoot mempty) mempty S.Nothing) + , ("settings", ScopeInformation settingvars mempty mempty (CurContainer (ContClass "settings") mempty) mempty S.Nothing) + ] initialclass = mempty & at "::" ?~ (IncludeStandard :!: dummypos) dummypos :: PPosition diff --git a/Puppet/Preferences.hs b/Puppet/Preferences.hs --- a/Puppet/Preferences.hs +++ b/Puppet/Preferences.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Puppet.Preferences ( dfPreferences @@ -53,6 +54,9 @@ , _knownusers :: [Text] , _knowngroups :: [Text] , _externalmodules :: HS.HashSet Text + , _puppetSettings :: Container Text + , _factsOverride :: Container PValue + , _factsDefault :: Container PValue } data Defaults = Defaults @@ -62,6 +66,9 @@ , _dfStrictness :: Maybe Strictness , _dfExtratests :: Maybe Bool , _dfExternalmodules :: Maybe [Text] + , _dfPuppetSettings :: Maybe (Container Text) + , _dfFactsDefault :: Maybe (Container PValue) + , _dfFactsOverride :: Maybe (Container PValue) } deriving Show @@ -75,6 +82,9 @@ <*> v .:? "strict" <*> v .:? "extratests" <*> v .:? "externalmodules" + <*> v .:? "settings" + <*> v .:? "factsdefault" + <*> v .:? "factsoverride" parseJSON _ = mzero -- | generate default preferences @@ -88,7 +98,8 @@ typenames <- fmap (map takeBaseName) (getFiles (T.pack modulesdir) "lib/puppet/type" ".rb") defaults <- loadDefaults (testdir ++ "/defaults.yaml") let loadedTypes = HM.fromList (map defaulttype typenames) - return $ Preferences (PuppetDirPaths basedir manifestdir modulesdir templatedir testdir) + let dirpaths = PuppetDirPaths basedir manifestdir modulesdir templatedir testdir + return $ Preferences dirpaths dummyPuppetDB (baseNativeTypes `HM.union` loadedTypes) stdlibFunctions (Just (basedir <> "/hiera.yaml")) @@ -98,7 +109,9 @@ (getKnownusers defaults) (getKnowngroups defaults) (getExternalmodules defaults) - + (getPuppetSettings dirpaths defaults) + (getFactsOverride defaults) + (getFactsDefault defaults) loadDefaults :: FilePath -> IO (Maybe Defaults) loadDefaults fp = do @@ -110,25 +123,32 @@ -- no default yaml file or -- not key/value for the option has been provided getKnownusers :: Maybe Defaults -> [Text] -getKnownusers (Just df) = fromMaybe (getKnownusers Nothing) (_dfKnownusers df) -getKnownusers Nothing = ["mysql", "vagrant","nginx", "nagios", "postgres", "puppet", "root", "syslog", "www-data"] +getKnownusers = fromMaybe ["mysql", "vagrant","nginx", "nagios", "postgres", "puppet", "root", "syslog", "www-data"] . (>>= _dfKnownusers) getKnowngroups :: Maybe Defaults -> [Text] -getKnowngroups (Just df) = fromMaybe (getKnowngroups Nothing) (_dfKnowngroups df) -getKnowngroups Nothing = ["adm", "syslog", "mysql", "nagios","postgres", "puppet", "root", "www-data"] +getKnowngroups = fromMaybe ["adm", "syslog", "mysql", "nagios","postgres", "puppet", "root", "www-data"] . (>>= _dfKnowngroups) getStrictness :: Maybe Defaults -> Strictness -getStrictness (Just df) = fromMaybe (getStrictness Nothing) (_dfStrictness df) -getStrictness Nothing = Permissive +getStrictness = fromMaybe Permissive . (>>= _dfStrictness) getIgnoredmodules :: Maybe Defaults -> HS.HashSet Text -getIgnoredmodules (Just df) = maybe (getIgnoredmodules Nothing) HS.fromList (_dfIgnoredmodules df) -getIgnoredmodules Nothing = mempty +getIgnoredmodules = maybe mempty HS.fromList . (>>= _dfIgnoredmodules) getExtraTests :: Maybe Defaults -> Bool -getExtraTests (Just df) = fromMaybe (getExtraTests Nothing) (_dfExtratests df) -getExtraTests Nothing = True +getExtraTests = fromMaybe True . (>>= _dfExtratests) getExternalmodules :: Maybe Defaults -> HS.HashSet Text -getExternalmodules (Just df) = maybe (getExternalmodules Nothing) HS.fromList (_dfExternalmodules df) -getExternalmodules Nothing = mempty +getExternalmodules = maybe mempty HS.fromList . (>>= _dfExternalmodules) + +getPuppetSettings :: PuppetDirPaths -> Maybe Defaults -> Container Text +getPuppetSettings dirpaths = fromMaybe df . (>>= _dfPuppetSettings) + where + df :: Container Text + df = HM.fromList [ ("confdir", T.pack $ dirpaths^.baseDir) + ] + +getFactsOverride :: Maybe Defaults -> Container PValue +getFactsOverride = fromMaybe mempty . (>>= _dfFactsOverride) + +getFactsDefault :: Maybe Defaults -> Container PValue +getFactsDefault = fromMaybe mempty . (>>= _dfFactsDefault) diff --git a/PuppetDB/Common.hs b/PuppetDB/Common.hs --- a/PuppetDB/Common.hs +++ b/PuppetDB/Common.hs @@ -11,7 +11,6 @@ import Data.List (stripPrefix) import Control.Lens import System.Environment -import qualified Data.Either.Strict as S import Data.Vector.Lens import Servant.Common.BaseUrl @@ -38,13 +37,13 @@ tsts = stripPrefix "test" r -- | Given a 'PDBType', will try return a sane default implementation. -getDefaultDB :: PDBType -> IO (S.Either PrettyError (PuppetDBAPI IO)) -getDefaultDB PDBDummy = return (S.Right dummyPuppetDB) +getDefaultDB :: PDBType -> IO (Either PrettyError (PuppetDBAPI IO)) +getDefaultDB PDBDummy = return (Right dummyPuppetDB) getDefaultDB PDBRemote = let Right url = parseBaseUrl "http://localhost:8080" in pdbConnect url getDefaultDB PDBTest = lookupEnv "HOME" >>= \case Just h -> loadTestDB (h ++ "/.testdb") - Nothing -> fmap S.Right initTestDB + Nothing -> fmap Right initTestDB -- | Turns a 'FinalCatalog' and 'EdgeMap' into a document that can be -- serialized and fed to @puppet apply@. diff --git a/PuppetDB/Remote.hs b/PuppetDB/Remote.hs --- a/PuppetDB/Remote.hs +++ b/PuppetDB/Remote.hs @@ -10,48 +10,42 @@ import Puppet.Interpreter.Types import Data.Text (Text) import Control.Monad.Trans.Either -import qualified Data.Either.Strict as S import Servant.API import Servant.Client -import Servant.Common.Text import Data.Aeson import Data.Proxy -type PDBAPIv3 = "nodes" :> QueryParam "query" (Query NodeField) :> Get [PNodeInfo] - :<|> "nodes" :> Capture "resourcename" Text :> "resources" :> QueryParam "query" (Query ResourceField) :> Get [Resource] - :<|> "facts" :> QueryParam "query" (Query FactField) :> Get [PFactInfo] - :<|> "resources" :> QueryParam "query" (Query ResourceField) :> Get [Resource] +type PDBAPIv3 = "nodes" :> QueryParam "query" (Query NodeField) :> Get '[JSON] [PNodeInfo] + :<|> "nodes" :> Capture "resourcename" Text :> "resources" :> QueryParam "query" (Query ResourceField) :> Get '[JSON] [Resource] + :<|> "facts" :> QueryParam "query" (Query FactField) :> Get '[JSON] [PFactInfo] + :<|> "resources" :> QueryParam "query" (Query ResourceField) :> Get '[JSON] [Resource] type PDBAPI = "v3" :> PDBAPIv3 -spdbAPI :: Proxy PDBAPI -spdbAPI = Proxy - -sgetNodes :: Maybe (Query NodeField) -> BaseUrl -> EitherT String IO [PNodeInfo] -sgetNodeResources :: Text -> Maybe (Query ResourceField) -> BaseUrl -> EitherT String IO [Resource] -sgetFacts :: Maybe (Query FactField) -> BaseUrl -> EitherT String IO [PFactInfo] -sgetResources :: Maybe (Query ResourceField) -> BaseUrl -> EitherT String IO [Resource] -( sgetNodes - :<|> sgetNodeResources - :<|> sgetFacts - :<|> sgetResources - ) = client spdbAPI +api :: Proxy PDBAPI +api = Proxy -- | Given an URL (ie. @http://localhost:8080@), will return an incomplete 'PuppetDBAPI'. -pdbConnect :: BaseUrl -> IO (S.Either PrettyError (PuppetDBAPI IO)) -pdbConnect url = return $ S.Right $ PuppetDBAPI - (return (string $ show url)) - (const (left "operation not supported")) - (const (left "operation not supported")) - (const (left "operation not supported")) - (q1 sgetFacts) - (q1 sgetResources) - (q1 sgetNodes) - (left "operation not supported") - (\ndename q -> prettyError $ sgetNodeResources ndename (Just q) url) - where - prettyError :: EitherT String IO b -> EitherT PrettyError IO b - prettyError = bimapEitherT (PrettyError . string) id - q1 :: (ToText a, FromJSON b) => (Maybe a -> BaseUrl -> EitherT String IO b) -> a -> EitherT PrettyError IO b - q1 f x = prettyError $ f (Just x) url +pdbConnect :: BaseUrl -> IO (Either PrettyError (PuppetDBAPI IO)) +pdbConnect url = + return $ Right $ PuppetDBAPI + (return (string $ show url)) + (const (left "operation not supported")) + (const (left "operation not supported")) + (const (left "operation not supported")) + (q1 sgetFacts) + (q1 sgetResources) + (q1 sgetNodes) + (left "operation not supported") + (\ndename q -> prettyError $ sgetNodeResources ndename (Just q)) + where + sgetNodes :: Maybe (Query NodeField) -> EitherT ServantError IO [PNodeInfo] + sgetNodeResources :: Text -> Maybe (Query ResourceField) -> EitherT ServantError IO [Resource] + sgetFacts :: Maybe (Query FactField) -> EitherT ServantError IO [PFactInfo] + sgetResources :: Maybe (Query ResourceField) -> EitherT ServantError IO [Resource] + (sgetNodes :<|> sgetNodeResources :<|> sgetFacts :<|> sgetResources) = client api url + prettyError :: EitherT ServantError IO b -> EitherT PrettyError IO b + prettyError = bimapEitherT (PrettyError . string. show) id + q1 :: (ToText a, FromJSON b) => (Maybe a -> EitherT ServantError IO b) -> a -> EitherT PrettyError IO b + q1 f = prettyError . f . Just diff --git a/PuppetDB/TestDB.hs b/PuppetDB/TestDB.hs --- a/PuppetDB/TestDB.hs +++ b/PuppetDB/TestDB.hs @@ -18,7 +18,6 @@ import Control.Monad.Trans.Either import Data.Aeson.Lens import Data.CaseInsensitive -import qualified Data.Either.Strict as S import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import Data.List (foldl') @@ -53,20 +52,20 @@ toJSON (DBContent r f _) = object [("resources", toJSON r), ("facts", toJSON f)] -- | Initializes the test DB using a file to back its content -loadTestDB :: FilePath -> IO (S.Either PrettyError (PuppetDBAPI IO)) +loadTestDB :: FilePath -> IO (Either PrettyError (PuppetDBAPI IO)) loadTestDB fp = decodeFileEither fp >>= \case - Left (OtherParseException rr) -> return (S.Left (PrettyError (string (show rr)))) + Left (OtherParseException rr) -> return (Left (PrettyError (string (show rr)))) Left (InvalidYaml Nothing) -> baseError "Unknown error" Left (InvalidYaml (Just (YamlException s))) -> if take 21 s == "Yaml file not found: " then newFile else baseError (string s) Left (InvalidYaml (Just (YamlParseException pb ctx (YamlMark _ l c)))) -> baseError $ red (string pb <+> string ctx) <+> "at line" <+> int l <> ", column" <+> int c Left _ -> newFile - Right x -> fmap S.Right (genDBAPI (x & backingFile ?~ fp )) + Right x -> fmap Right (genDBAPI (x & backingFile ?~ fp )) where - baseError r = return $ S.Left $ PrettyError $ "Could not parse" <+> string fp <> ":" <+> r - newFile = S.Right <$> genDBAPI (newDB & backingFile ?~ fp ) + baseError r = return $ Left $ PrettyError $ "Could not parse" <+> string fp <> ":" <+> r + newFile = Right <$> genDBAPI (newDB & backingFile ?~ fp ) -- | Starts a new PuppetDB, without any backing file. initTestDB :: IO (PuppetDBAPI IO) diff --git a/README.adoc b/README.adoc --- a/README.adoc +++ b/README.adoc @@ -95,11 +95,6 @@ Displays the catalog as a Puppet-compatible JSON file, that can then be used with `puppet apply`. -`--facts-override` and `--facts-defaults`:: - -Both options expect a path to a YAML file defining facts. The first option will override the facts that are collected locally, while the second will merely provide default values -for them. - `--strict`:: Enable strict check. 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: 1.1.1.2 +version: 1.1.3 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/ @@ -78,9 +78,9 @@ ghc-options: -Wall -funbox-strict-fields ghc-prof-options: -auto-all -caf-all build-depends: base >=4.6 && < 4.9 - , aeson >= 0.7 && < 0.9 + , aeson >= 0.8 && < 0.9 , ansi-wl-pprint == 0.6.* - , attoparsec >= 0.11 && < 0.13 + , attoparsec >= 0.13 && < 0.14 , base16-bytestring == 0.1.* , bytestring , case-insensitive == 1.2.* @@ -91,7 +91,7 @@ , exceptions >= 0.8 && < 0.9 , filecache >= 0.2.8 && < 0.3 , hashable == 1.2.* - , hruby >= 0.3 && <0.4 + , hruby >= 0.3.1.4 && <0.4 , hslogger == 1.2.* , hslua >= 0.3.10 && < 0.4 , lens >= 4.9 && < 5 @@ -105,8 +105,8 @@ , process >= 1.1 && < 1.3 , regex-pcre-builtin >= 0.94.4 , scientific >= 0.2 && < 0.4 - , servant == 0.2.* - , servant-client == 0.2.* + , servant == 0.4.* + , servant-client == 0.4.* , split == 0.2.* , stm == 2.4.* , strict-base-types >= 0.2.2 @@ -122,7 +122,7 @@ type: exitcode-stdio-1.0 ghc-options: -Wall -rtsopts -threaded extensions: OverloadedStrings - build-depends: language-puppet,base,text,lens,parsers + build-depends: language-puppet,base,text,lens,parsers,hspec main-is: evals.hs Test-Suite test-lexer hs-source-dirs: tests diff --git a/progs/PuppetResources.hs b/progs/PuppetResources.hs --- a/progs/PuppetResources.hs +++ b/progs/PuppetResources.hs @@ -11,14 +11,13 @@ import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Either (partitionEithers) import qualified Data.Either.Strict as S -import Data.Foldable (foldMap) +import Data.Foldable import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import Data.List (isInfixOf) import Data.Maybe (fromMaybe, isNothing, mapMaybe) import Data.Monoid hiding (First) import qualified Data.Set as Set -import Data.String (fromString) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Text.Strict.Lens @@ -32,7 +31,6 @@ import qualified System.Log.Logger as LOG import qualified Text.Parsec as P import Text.Regex.PCRE.String -import Prelude import Facter import Puppet.Daemon @@ -45,12 +43,13 @@ import Puppet.PP import Puppet.Preferences import Puppet.Stats -import Puppet.Utils import PuppetDB.Common import PuppetDB.Dummy import PuppetDB.Remote import PuppetDB.TestDB +import Prelude + type QueryFunc = Nodename -> IO (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) data MultNodes = MultNodes [T.Text] | AllNodes deriving Show @@ -73,8 +72,6 @@ , _optPdbfile :: Maybe FilePath , _optLoglevel :: LOG.Priority , _optHieraFile :: Maybe FilePath - , _optFactsOverr :: Maybe FilePath - , _optFactsDefault :: Maybe FilePath , _optCommitDB :: Bool , _optCheckExport :: Bool , _optIgnoredMods :: Maybe (HS.HashSet T.Text) @@ -131,12 +128,6 @@ ( long "hiera" <> help "Path to the Hiera configuration file (default hiera.yaml)" <> value "hiera.yaml")) - <*> optional (strOption - ( long "facts-override" - <> help "Path to a Yaml file containing a list of 'facts' that will override locally resolved facts")) - <*> optional (strOption - ( long "facts-defaults" - <> help "Path to a Yaml file containing a list of 'facts' that will be used as defaults")) <*> switch ( long "commitdb" <> help "Commit the computed catalogs in the puppetDB") @@ -157,9 +148,9 @@ ( long "noextratests" <> help "Disable extra tests (eg.: check that files exist on local disk") -checkError :: Doc -> S.Either PrettyError a -> IO a -checkError r (S.Left rr) = error (show (red r <> ": " <+> getError rr)) -checkError _ (S.Right x) = return x +checkError :: Show e => Doc -> Either e a -> IO a +checkError r (Left rr) = error (show (red r <> ": " <+> (string . show) rr)) +checkError _ (Right x) = return x -- | Like catMaybes, but it counts the Nothing values catMaybesCount :: [Maybe a] -> ([a], Sum Int) @@ -181,24 +172,22 @@ pdbapi <- case (_optPdburl, _optPdbfile) of (Nothing, Nothing) -> return dummyPuppetDB (Just _, Just _) -> error "You must choose between a testing PuppetDB and a remote one" - (Just url, _) -> checkError "Error when parsing url" (parseBaseUrl url & either (S.Left . fromString) S.Right) + (Just url, _) -> checkError "Error when parsing url" (parseBaseUrl url) >>= pdbConnect >>= checkError "Error when connecting to the remote PuppetDB" (_, Just file) -> loadTestDB file >>= checkError "Error when initializing the PuppetDB API" - !factsOverrides <- case (_optFactsOverr, _optFactsDefault) of - (Just _, Just _) -> error "You can't use --facts-override and --facts-defaults at the same time" - (Just p, Nothing) -> HM.union `fmap` loadYamlFile p - (Nothing, Just p) -> flip HM.union `fmap` loadYamlFile p - (Nothing, Nothing) -> return id prf <- dfPreferences workingdir <&> prefPDB .~ pdbapi <&> hieraPath .~ _optHieraFile <&> ignoredmodules %~ (`fromMaybe` _optIgnoredMods) <&> (if _optStrictMode then strictness .~ Strict else id) <&> (if _optNoExtraTests then extraTests .~ False else id) q <- initDaemon prf - let queryfunc = \node -> fmap factsOverrides (puppetDBFacts node pdbapi) >>= _dGetCatalog q node + let queryfunc = \node -> fmap (unifyFacts (prf^.factsDefault) (prf^.factsOverride)) (puppetDBFacts node pdbapi) >>= _dGetCatalog q node return (queryfunc, pdbapi, _dParserStats q, _dCatalogStats q, _dTemplateStats q) - + where + -- merge 3 sets of facts : some defaults, the original set and some override + unifyFacts :: Container PValue -> Container PValue -> Container PValue -> Container PValue + unifyFacts defaults override c = override `HM.union` c `HM.union` defaults parseFile :: FilePath -> IO (Either P.ParseError (V.Vector Statement)) parseFile = fmap . runPParser puppetParser <*> T.readFile diff --git a/progs/pdbQuery.hs b/progs/pdbQuery.hs --- a/progs/pdbQuery.hs +++ b/progs/pdbQuery.hs @@ -96,14 +96,14 @@ (Just l, PDBTest) -> loadTestDB l (_, x) -> getDefaultDB x pdbapi <- case epdbapi of - S.Left r -> error (show r) - S.Right x -> return x + Left r -> error (show r) + Right x -> return x case _pdbcmd cmdl of DumpFacts -> if _pdbtype cmdl == PDBDummy then puppetDBFacts "dummy" pdbapi >>= mapM_ print . HM.toList else do allfacts <- runCheck "get facts" (getFacts pdbapi QEmpty) - tmpdb <- loadTestDB "/tmp/allfacts.yaml" >>= checkErrorS "load test db" + tmpdb <- loadTestDB "/tmp/allfacts.yaml" >>= checkError "load test db" let groupfacts = foldl' groupfact HM.empty allfacts groupfact curmap (PFactInfo ndname fctname fctval) = curmap & at ndname . non HM.empty %~ (at fctname ?~ fctval) @@ -116,7 +116,7 @@ runCheck "replace facts" (replaceFacts pdbapi [(n, fcts)]) runCheck "commit db" (commitDB pdbapi) CreateTestDB destfile -> do - ndb <- loadTestDB destfile >>= checkErrorS "puppetdb load" + ndb <- loadTestDB destfile >>= checkError "puppetdb load" allnodes <- runCheck "get nodes" (getNodes pdbapi QEmpty) allfacts <- runCheck "get facts" (getFacts pdbapi QEmpty) let factsGrouped = HM.toList $ HM.fromListWith (<>) $ map (\x -> (x ^. nodename, HM.singleton (x ^. factname) (x ^. factval))) allfacts diff --git a/ruby/hrubyerb.rb b/ruby/hrubyerb.rb --- a/ruby/hrubyerb.rb +++ b/ruby/hrubyerb.rb @@ -1,5 +1,6 @@ require 'erb' require 'digest/md5' +require 'yaml' class Scope def initialize(context,variables) @@ -38,6 +39,10 @@ def to_hash vl('~g~e~t_h~a~s~h~') + end + + def function_to_yaml(args) + args.to_yaml end def function_versioncmp(args) diff --git a/tests/evals.hs b/tests/evals.hs --- a/tests/evals.hs +++ b/tests/evals.hs @@ -7,9 +7,11 @@ import Puppet.Interpreter.Types import Puppet.Interpreter.Resolve +import Test.Hspec import Control.Applicative import Text.Parser.Combinators (eof) -import Data.Either (lefts) +import Data.Foldable (forM_) +import Prelude pureTests :: [T.Text] pureTests = [ "4 + 2 == 6" @@ -20,10 +22,11 @@ , "[1,2,3] << 10 == [1,2,3,10]" , "[1,2,3] << [4,5] == [1,2,3,[4,5]]" , "4 / 2.0 == 2" + , "$settings::confdir == '/etc/puppet'" ] main :: IO () -main = do +main = hspec $ do let check :: T.Text -> Either String () check t = case runPParser (expression <* eof) "dummy" t of Left rr -> Left (T.unpack t ++ " -> " ++ show rr) @@ -31,4 +34,4 @@ Right (PBoolean True) -> Right () Right x -> Left (T.unpack t ++ " -> " ++ show (pretty x)) Left rr -> Left (T.unpack t ++ " -> " ++ show rr) - mapM_ putStrLn (lefts $ map check pureTests) + describe "evaluation" $ forM_ pureTests $ \t -> it ("should evaluate " ++ show t) $ either error (const True) (check t)