language-puppet 1.1.1.2 → 1.1.3
raw patch · 15 files changed
+127/−107 lines, 15 filesdep ~aesondep ~attoparsecdep ~hruby
Dependency ranges changed: aeson, attoparsec, hruby, hspec, servant, servant-client
Files
- CHANGELOG.markdown +8/−0
- Puppet/Daemon.hs +1/−0
- Puppet/Interpreter.hs +3/−2
- Puppet/Interpreter/Pure.hs +2/−1
- Puppet/Interpreter/Types.hs +9/−4
- Puppet/Preferences.hs +34/−14
- PuppetDB/Common.hs +3/−4
- PuppetDB/Remote.hs +28/−34
- PuppetDB/TestDB.hs +5/−6
- README.adoc +0/−5
- language-puppet.cabal +7/−7
- progs/PuppetResources.hs +12/−23
- progs/pdbQuery.hs +4/−4
- ruby/hrubyerb.rb +5/−0
- tests/evals.hs +6/−3
CHANGELOG.markdown view
@@ -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.
Puppet/Daemon.hs view
@@ -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)
Puppet/Interpreter.hs view
@@ -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
Puppet/Interpreter/Pure.hs view
@@ -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.
Puppet/Interpreter/Types.hs view
@@ -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
Puppet/Preferences.hs view
@@ -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)
PuppetDB/Common.hs view
@@ -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@.
PuppetDB/Remote.hs view
@@ -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
PuppetDB/TestDB.hs view
@@ -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)
README.adoc view
@@ -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.
language-puppet.cabal view
@@ -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
progs/PuppetResources.hs view
@@ -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
progs/pdbQuery.hs view
@@ -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
ruby/hrubyerb.rb view
@@ -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)
tests/evals.hs view
@@ -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)