language-puppet 1.3.10 → 1.3.11
raw patch · 24 files changed
+362/−187 lines, 24 filesdep ~Globdep ~ansi-wl-pprintdep ~basenew-component:exe:yera
Dependency ranges changed: Glob, ansi-wl-pprint, base, strict-base-types, text, unordered-containers
Files
- CHANGELOG.markdown +7/−0
- Erb/Ruby.hs +0/−1
- Hiera/Server.hs +120/−78
- Puppet/Interpreter.hs +3/−3
- Puppet/Interpreter/Resolve.hs +22/−21
- Puppet/Interpreter/Resolve/Sprintf.hs +4/−3
- Puppet/Interpreter/Types.hs +21/−14
- Puppet/Lens.hs +13/−6
- Puppet/NativeTypes/Helpers.hs +6/−6
- Puppet/NativeTypes/Mount.hs +2/−2
- Puppet/NativeTypes/User.hs +2/−1
- Puppet/NativeTypes/ZoneRecord.hs +2/−1
- Puppet/PP.hs +1/−1
- Puppet/Parser.hs +3/−0
- Puppet/Parser/Types.hs +42/−21
- Puppet/Stdlib.hs +6/−2
- PuppetDB/Common.hs +1/−1
- PuppetDB/Dummy.hs +1/−0
- README.adoc +12/−4
- language-puppet.cabal +15/−2
- progs/PuppetResources.hs +1/−1
- progs/yera.hs +59/−0
- tests/Helpers.hs +1/−1
- tests/hiera.hs +18/−18
CHANGELOG.markdown view
@@ -1,3 +1,10 @@+# v1.3.11 (2017/10/07)++* Added yera command+* Minor fixes to the validate_integer function, and to the mount resource+* Support for the "lookup" command in hiera files+* Fix Glob compilation problem+ # v1.3.10 (2017/08/28) * Add `sort` stdlib function
Erb/Ruby.hs view
@@ -55,4 +55,3 @@ | DropPrevSpace' | DropNextSpace !RubyStatement deriving(Show,Eq)-
Hiera/Server.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-} {- | This module runs a Hiera server that caches Hiera data. There is a huge caveat : only the data files are watched for changes, not the main configuration file.@@ -19,8 +20,9 @@ ) where import Control.Applicative-import Control.Exception import Control.Lens+import Control.Monad.Except+import Control.Monad.Trans.Reader import Control.Monad.Writer.Strict import Data.Aeson (FromJSON, Value (..), (.!=), (.:?)) import qualified Data.Aeson as A@@ -29,9 +31,9 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.Either.Strict as S import qualified Data.FileCache as F-import qualified Data.HashMap.Strict as HM import qualified Data.List as L-import Data.Maybe (fromMaybe, catMaybes)+import Data.Maybe (catMaybes, mapMaybe)+import Data.String (fromString) import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Yaml as Y@@ -54,21 +56,29 @@ | JsonBackend FilePath deriving Show -newtype InterpolableHieraString = InterpolableHieraString [HieraStringPart]+newtype InterpolableHieraString = InterpolableHieraString { getInterpolableHieraString :: [HieraStringPart] } deriving Show -data HieraStringPart = HString T.Text- | HVariable T.Text+data HieraStringPart = HPString T.Text+ | HPVariable T.Text deriving Show instance Pretty HieraStringPart where- pretty (HString t) = ttext t- pretty (HVariable v) = dullred (string "%{" <> ttext v <> string "}")+ pretty (HPString t) = ttext t+ pretty (HPVariable v) = dullred (string "%{" <> ttext v <> string "}") prettyList = mconcat . map pretty -type Cache = F.FileCacheR String Y.Value+type Cache = F.FileCacheR String Value +data QRead+ = QRead+ { _qvars :: Container T.Text+ , _qtype :: HieraQueryType+ , _qhier :: [Value]+ }+ makeClassy ''HieraConfigFile+makeLenses ''QRead instance FromJSON InterpolableHieraString where parseJSON (String s) = case parseInterpolableString s of@@ -91,12 +101,12 @@ return (backendConstructor (T.unpack datadir)) HieraConfigFile <$> (v .:? ":backends" .!= ["yaml"] >>= mapM genBackend)- <*> (v .:? ":hierarchy" .!= [InterpolableHieraString [HString "common"]])+ <*> (v .:? ":hierarchy" .!= [InterpolableHieraString [HPString "common"]]) parseJSON _ = fail "Not a valid Hiera configuration" -- | An attoparsec parser that turns text into parts that are ready for interpolation interpolableString :: AT.Parser [HieraStringPart]-interpolableString = AT.many1 (fmap HString rawPart <|> fmap HVariable interpPart)+interpolableString = AT.many1 (fmap HPString rawPart <|> fmap HPVariable interpPart) where rawPart = AT.takeWhile1 (/= '%') interpPart = AT.string "%{" *> AT.takeWhile1 (/= '}') <* AT.char '}'@@ -119,74 +129,106 @@ dummyHiera :: Monad m => HieraQueryFunc m dummyHiera _ _ _ = return $ S.Right Nothing --- | The combinator for "normal" queries-queryCombinator :: HieraQueryType -> [IO (Maybe PValue)] -> IO (Maybe PValue)-queryCombinator qt = fmap (createOutput . catMaybes) . sequence- where- createOutput :: [PValue] -> Maybe PValue- createOutput [] = Nothing- createOutput xs = case qt of- Priority -> return (head xs)- ArrayMerge -> return (rejoin xs)- HashMerge -> PHash . mconcat <$> mapM toH xs- rejoin = PArray . V.fromList . L.nub . concatMap toA- toA (PArray r) = V.toList r- toA a = [a]- toH (PHash h) = Just h- toH _ = Nothing+resolveString :: Container T.Text -> InterpolableHieraString -> Maybe T.Text+resolveString vars = fmap T.concat . mapM resolve . getInterpolableHieraString+ where+ resolve (HPString x) = Just x+ resolve (HPVariable v) = vars ^? ix v -interpolateText :: Container T.Text -> T.Text -> T.Text-interpolateText vars t = fromMaybe t ((parseInterpolableString t ^? _Right) >>= resolveInterpolable vars)+query :: HieraConfigFile -> FilePath -> Cache -> HieraQueryFunc IO+query HieraConfigFile {_backends, _hierarchy} fp cache vars hquery qt = do+ -- step 1, resolve hierarchies+ let searchin = do+ mhierarchy <- resolveString vars <$> _hierarchy+ Just hier <- [mhierarchy]+ backend <- _backends+ let decodeInfo :: (FilePath -> IO (S.Either String Value), String, String)+ decodeInfo+ = case backend of+ JsonBackend d -> (fmap (strictifyEither . A.eitherDecode') . BS.readFile , d, ".json")+ YamlBackend d -> (fmap (strictifyEither . (_Left %~ show)) . Y.decodeFileEither, d, ".yaml")+ return (decodeInfo, hier)+ -- step 2, read all the files, returning a raw data structure+ mvals <- forM searchin $ \((decodefunction, datadir, extension), hier) -> do+ let filename = basedir <> datadir <> "/" <> T.unpack hier <> extension+ basedir = case datadir of+ '/' : _ -> mempty+ _ -> fp ^. directory <> "/"+ efilecontent <- F.query cache filename (decodefunction filename)+ case efilecontent of+ S.Left r -> do+ let errs = "Hiera: error when reading file " <> string filename <+> string r+ if "Yaml file not found: " `L.isInfixOf` r+ then LOG.debugM hieraLoggerName (show errs)+ else LOG.warningM hieraLoggerName (show errs)+ return Nothing+ S.Right val -> return (Just val)+ let vals = catMaybes mvals+ -- step 3, query through all the results+ return (strictifyEither $ runReader (runExceptT (recursiveQuery hquery [])) (QRead vars qt vals)) -resolveInterpolable :: Container T.Text -> [HieraStringPart] -> Maybe T.Text-resolveInterpolable vars = fmap T.concat . mapM resolvePart- where- resolvePart :: HieraStringPart -> Maybe T.Text- resolvePart (HString x) = Just x- resolvePart (HVariable v) = vars ^. at v+type QM a = ExceptT PrettyError (Reader QRead) a -interpolatePValue :: Container T.Text -> PValue -> PValue-interpolatePValue v (PHash h) = PHash . HM.fromList . map ( (_1 %~ interpolateText v) . (_2 %~ interpolatePValue v) ) . HM.toList $ h-interpolatePValue v (PArray r) = PArray (fmap (interpolatePValue v) r)-interpolatePValue v (PString t) = PString (interpolateText v t)-interpolatePValue _ x = x+checkLoop :: T.Text -> [T.Text] -> QM ()+checkLoop x xs =+ when (x `elem` xs) (throwError ("Loop in hiera: " <> fromString (T.unpack (T.intercalate ", " (x:xs))))) -query :: HieraConfigFile -> FilePath -> Cache -> HieraQueryFunc IO-query (HieraConfigFile {_backends, _hierarchy}) fp cache vars hquery qtype =- fmap S.Right (queryCombinator qtype (map query' _hierarchy)) `catch` (\e -> return . S.Left . PrettyError . string . show $ (e :: SomeException))- where- varlist = hcat (L.intersperse comma (map (dullblue . ttext) (L.sort (HM.keys vars))))- query' :: InterpolableHieraString -> IO (Maybe PValue)- query' (InterpolableHieraString strs) =- case resolveInterpolable vars strs of- Just s -> queryCombinator qtype (map (query'' s) _backends)- Nothing -> do- LOG.infoM hieraLoggerName (show $ "Hiera lookup: skipping using hierarchy level" <+> pretty strs- <$$> "It couldn't be interpolated with known variables:" <+> varlist)- return Nothing- query'' :: T.Text -> Backend -> IO (Maybe PValue)- query'' hierastring backend = do- let (decodefunction, datadir, extension) = case backend of- (JsonBackend d) -> (fmap (strictifyEither . A.eitherDecode') . BS.readFile , d, ".json")- (YamlBackend d) -> (fmap (strictifyEither . (_Left %~ show)) . Y.decodeFileEither, d, ".yaml")- filename = basedir <> datadir <> "/" <> T.unpack hierastring <> extension- where- basedir = case datadir of- '/' : _ -> mempty- _ -> fp^.directory <> "/"- mfromJSON :: Maybe Value -> IO (Maybe PValue)- mfromJSON Nothing = return Nothing- mfromJSON (Just v) = case A.fromJSON v of- A.Success a -> return (Just (interpolatePValue vars a))- _ -> do- LOG.warningM hieraLoggerName (show $ "Hiera:" <+> dullred "could not convert this Value to a Puppet type" <> ":" <+> string (show v))- return Nothing- v <- liftIO (F.query cache filename (decodefunction filename))- case v of- S.Left r -> do- let errs = "Hiera: error when reading file " <> string filename <+> string r- if "Yaml file not found: " `L.isInfixOf` r- then LOG.debugM hieraLoggerName (show errs)- else LOG.warningM hieraLoggerName (show errs)- return Nothing- S.Right x -> mfromJSON (x ^? key hquery)+recursiveQuery :: T.Text -> [T.Text] -> QM (Maybe PValue)+recursiveQuery curquery prevqueries = do+ checkLoop curquery prevqueries+ rawlookups <- mapMaybe (preview (key curquery)) <$> view qhier+ lookups <- mapM (resolveValue (curquery : prevqueries)) rawlookups+ case lookups of+ [] -> return Nothing+ (x:xs) -> do+ qt <- view qtype+ let evalue = foldM (mergeWith qt) x xs+ case A.fromJSON <$> evalue of+ Left _ -> return Nothing+ Right (A.Success o) -> return o+ Right (A.Error rr) -> throwError ("Something horrible happened in recursiveQuery: " <> fromString (show rr))++resolveValue :: [T.Text] -> Value -> QM Value+resolveValue prevqueries value =+ case value of+ String t -> String <$> resolveText prevqueries t+ Array arr -> Array <$> mapM (resolveValue prevqueries) arr+ Object hh -> Object <$> mapM (resolveValue prevqueries) hh+ _ -> return value++resolveText :: [T.Text] -> T.Text -> QM T.Text+resolveText prevqueries t+ = case parseInterpolableString t of+ Right qparts -> T.concat <$> mapM (resolveStringPart prevqueries) qparts+ Left _ -> return t++resolveStringPart :: [T.Text] -> HieraStringPart -> QM T.Text+resolveStringPart prevqueries sp+ = case sp of+ HPString s -> return s+ HPVariable varname -> do+ let varsolve = fmap PString . preview (ix varname) <$> view qvars+ r <- case T.stripPrefix "lookup('" varname >>= T.stripSuffix "')" of+ Just lk -> recursiveQuery lk prevqueries+ Nothing -> varsolve+ case r of+ Just (PString v) -> return v+ _ -> return mempty++mergeWith :: HieraQueryType -> Value -> Value -> Either PrettyError Value+mergeWith qt cur new+ = case qt of+ QFirst -> return cur+ QUnique ->+ let getArray x = case x of+ Array array -> V.toList array+ _ -> [x]+ curarray = getArray cur+ newarray = getArray new+ in case new of+ Object _ -> throwError "Tried to merge a hash"+ _ -> return (Array (V.fromList (L.nub (curarray ++ newarray))))+ QHash -> case (cur, new) of+ (Object curh, Object newh) -> return (Object (curh <> newh))+ _ -> throwError (PrettyError ("Tried to merge things that are not hashes: " <> text (show cur) <+> text (show new)))+ QDeep{} -> throwError "deep queries not supported"
Puppet/Interpreter.hs view
@@ -575,7 +575,7 @@ checkHiera :: T.Text -> ExceptT (Max Bool) InterpreterMonad PValue checkHiera k = case wHiera of S.Nothing -> throwE (Max False)- S.Just classname -> lift (runHiera (classname <> "::" <> k) Priority) >>= checkUndef+ S.Just classname -> lift (runHiera (classname <> "::" <> k) QFirst) >>= checkUndef checkDef :: T.Text -> ExceptT (Max Bool) InterpreterMonad PValue checkDef k = checkUndef (params ^. at k)@@ -805,7 +805,7 @@ "class" -> {-# SCC "rrClass" #-} do definedResources . at resid ?= r let attrs = r ^. rattributes- fmap (r:) $ loadClass rn S.Nothing attrs ClassResourceLike+ (r:) <$> loadClass rn S.Nothing attrs ClassResourceLike _ -> {-# SCC "rrGeneralCase" #-} use (definedResources . at resid) >>= \case Just otheres -> throwPosError ("Resource" <+> pretty resid <+> "already defined:" </>@@ -870,7 +870,7 @@ mainFunctionCall "fail" _ = throwPosError "fail(): This function takes a single argument" mainFunctionCall "hiera_include" [x] = do ndname <- resolvePValueString x- classes <- toListOf (traverse . _PArray . traverse) <$> runHiera ndname ArrayMerge+ classes <- toListOf (traverse . _PArray . traverse) <$> runHiera ndname QUnique p <- use curPos curPos . _1 . lSourceName <>= " [hiera_include call]" o <- mainFunctionCall "include" classes
Puppet/Interpreter/Resolve.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE PackageImports #-} -- | This module is all about converting and resolving foreign data into -- the fully exploitable corresponding data type. The main use case is the -- conversion of 'Expression' to 'PValue'.@@ -28,13 +29,15 @@ hfRestorevars, toNumbers, fixResourceName,- datatypeMatch+ datatypeMatch,+ -- * Synonym+ NumberPair ) where import Control.Lens import Control.Monad import Control.Monad.Operational (singleton)-import Crypto.Hash+import "cryptonite" Crypto.Hash import Data.Aeson hiding ((.=)) import Data.Aeson.Lens hiding (key) import Data.Bits@@ -76,12 +79,10 @@ md5 :: ByteString -> ByteString md5 = convert . (hash :: ByteString -> Digest MD5) --- | A useful type that is used when trying to perform arithmetic on Puppet--- numbers.+-- | A useful type that is used when trying to perform arithmetic on Puppet numbers. type NumberPair = Pair Scientific Scientific --- | Converts class resource names to lowercase (fix for the jenkins--- plugin).+-- | Converts class resource names to lowercase (fix for the jenkins plugin). fixResourceName :: T.Text -- ^ Resource type -> T.Text -- ^ Resource name -> T.Text@@ -117,7 +118,7 @@ Just d -> return d Nothing -> throwPosError ("Lookup for " <> ttext qs <> " failed") --- | Tries to convert a pair of 'PValue's into 'Number's, as defined in+-- | Tries to convert a pair of 'PValue's into a 'NumberPair', as defined in -- attoparsec. If the two values can be converted, it will convert them so -- that they are of the same type toNumbers :: PValue -> PValue -> S.Maybe NumberPair@@ -130,7 +131,7 @@ -- | This tries to run a numerical binary operation on two puppet -- expressions. It will try to resolve them, then convert them to numbers--- (using 'toNumbners'), and will finally apply the correct operation.+-- (using 'toNumbers'), and will finally apply the correct operation. binaryOperation :: Expression -- ^ left operand -> Expression -- ^ right operand -> (Scientific -> Scientific -> Scientific) -- ^ operation@@ -428,7 +429,7 @@ checkStrict "The use of the 'defined' function is a code smell." "The 'defined' function is not allowed in strict mode." t <- resolvePValueString ut- if (not (T.null t) && T.head t == '$') -- variable test+ if not (T.null t) && T.head t == '$' -- variable test then do scps <- use scopes scp <- getScopeName@@ -489,7 +490,7 @@ escapeDangerous x | isDangerous x = T.snoc "\\" x | otherwise = T.singleton x between c s = c <> s <> c- return $ PString $ T.unwords $ V.toList $ fmap escape $ mconcat sargs+ return $ PString $ T.unwords $ V.toList (escape <$> mconcat sargs) resolveFunction' "mysql_password" [pstr] = fmap (PString . T.decodeUtf8 . B16.encode . sha1 . sha1 . T.encodeUtf8) (resolvePValueString pstr) resolveFunction' "mysql_password" _ = throwPosError "mysql_password(): Expects a single argument"@@ -529,15 +530,15 @@ resolveFunction' "pdbresourcequery" [q] = pdbresourcequery q Nothing resolveFunction' "pdbresourcequery" [q,k] = fmap Just (resolvePValueString k) >>= pdbresourcequery q resolveFunction' "pdbresourcequery" _ = throwPosError "pdbresourcequery(): Expects one or two arguments"-resolveFunction' "hiera" [q] = hieraCall Priority q Nothing Nothing-resolveFunction' "hiera" [q,d] = hieraCall Priority q (Just d) Nothing-resolveFunction' "hiera" [q,d,o] = hieraCall Priority q (Just d) (Just o)-resolveFunction' "hiera_array" [q] = hieraCall ArrayMerge q Nothing Nothing-resolveFunction' "hiera_array" [q,d] = hieraCall ArrayMerge q (Just d) Nothing-resolveFunction' "hiera_array" [q,d,o] = hieraCall ArrayMerge q (Just d) (Just o)-resolveFunction' "hiera_hash" [q] = hieraCall HashMerge q Nothing Nothing-resolveFunction' "hiera_hash" [q,d] = hieraCall HashMerge q (Just d) Nothing-resolveFunction' "hiera_hash" [q,d,o] = hieraCall HashMerge q (Just d) (Just o)+resolveFunction' "hiera" [q] = hieraCall QFirst q Nothing Nothing+resolveFunction' "hiera" [q,d] = hieraCall QFirst q (Just d) Nothing+resolveFunction' "hiera" [q,d,o] = hieraCall QFirst q (Just d) (Just o)+resolveFunction' "hiera_array" [q] = hieraCall QUnique q Nothing Nothing+resolveFunction' "hiera_array" [q,d] = hieraCall QUnique q (Just d) Nothing+resolveFunction' "hiera_array" [q,d,o] = hieraCall QUnique q (Just d) (Just o)+resolveFunction' "hiera_hash" [q] = hieraCall QHash q Nothing Nothing+resolveFunction' "hiera_hash" [q,d] = hieraCall QHash q (Just d) Nothing+resolveFunction' "hiera_hash" [q,d,o] = hieraCall QHash q (Just d) (Just o) resolveFunction' "hiera" _ = throwPosError "hiera(): Expects one, two or three arguments" -- user functions@@ -614,14 +615,14 @@ checkSearchExpression (REqualitySearch attributename v) r = case r ^. rattributes . at attributename of Nothing -> False- Just (PArray x) -> F.any (flip puppetEquality v) x+ Just (PArray x) -> F.any (`puppetEquality` v) x Just x -> puppetEquality x v checkSearchExpression (RNonEqualitySearch attributename v) r | attributename == "tag" = True | attributename == "title" = not (checkSearchExpression (REqualitySearch attributename v) r) | otherwise = case r ^. rattributes . at attributename of Nothing -> True- Just (PArray x) -> not (F.all (flip puppetEquality v) x)+ Just (PArray x) -> not (F.all (`puppetEquality` v) x) Just x -> not (puppetEquality x v) -- | Generates variable associations for evaluation of blocks. Each item
Puppet/Interpreter/Resolve/Sprintf.hs view
@@ -1,7 +1,9 @@-module Puppet.Interpreter.Resolve.Sprintf where+module Puppet.Interpreter.Resolve.Sprintf (+ sprintf+) where import Control.Applicative-import Control.Monad+import Control.Monad.Except import Data.Attoparsec.Text import Data.Scientific (Scientific) import qualified Data.Text as T@@ -141,4 +143,3 @@ go [] [] = return [] go _ [] = throwPosError "sprintf: not enough arguments" go [] _ = [] <$ let msg = "sprintf: too many arguments" in checkStrict msg msg-
Puppet/Interpreter/Types.hs view
@@ -8,6 +8,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}+ module Puppet.Interpreter.Types ( -- * Record & lenses HasResource(..)@@ -84,8 +85,7 @@ , EdgeMap -- * Classes , MonadThrowPos(..)- , MonadError(..)- -- * definitions+ -- * Definitions , metaparameters , showPos ) where@@ -176,20 +176,25 @@ _ -> Left p toNumber p = Left p --- | The different kind of hiera queries-data HieraQueryType = Priority -- ^ standard hiera query- | ArrayMerge -- ^ hiera_array- | HashMerge -- ^ hiera_hash+-- | The different kind of hiera queries.+data HieraQueryType+ = QFirst -- ^ standard hiera query+ | QUnique -- ^ hiera_array+ | QHash -- ^ hiera_hash+ | QDeep+ { _knockoutPrefix :: Maybe Text+ , _sortMerged :: Bool+ , _mergeHashArray :: Bool+ } deriving (Show) --- | The type of the Hiera API function+-- | The type of the Hiera API function. type HieraQueryFunc m = Container Text -- ^ All the variables that Hiera can interpolate, the top level ones being prefixed with :: -> Text -- ^ The query -> HieraQueryType -> m (S.Either PrettyError (Maybe PValue)) -- | The intepreter can run in two modes : a strict mode (recommended), and--- a permissive mode. The permissive mode let known antipatterns work with--- the interpreter.+-- a permissive mode. data Strictness = Strict | Permissive deriving (Show, Eq) @@ -206,13 +211,12 @@ deriving (Show, Eq) -- | Puppet has two main ways to declare classes: include-like and resource-like--- https://docs.puppetlabs.com/puppet/latest/reference/lang_classes.html#include-like-vs-resource-like+-- See <https://docs.puppetlabs.com/puppet/latest/reference/lang_classes.html#include-like-vs-resource-like puppet reference> data ClassIncludeType = ClassIncludeLike -- ^ using the include or contain function | ClassResourceLike -- ^ resource like declaration deriving (Eq) --- |This type is used to differenciate the distinct top level types that are--- exposed by the DSL.+-- | This type is used to differenciate the distinct top level types that are exposed by the DSL. data TopLevelType -- |This is for node entries. = TopNode@@ -250,7 +254,7 @@ | SEChild !Text -- ^ We enter the scope as the child of another class | SEParent !Text -- ^ We enter the scope as the parent of another class --- | TODO related to Scope: explain ...+-- TODO related to Scope: explain ... data CurContainer = CurContainer { _cctype :: !CurContainerDesc , _cctags :: !(HS.HashSet Text)@@ -334,6 +338,7 @@ -- | The main monad type InterpreterMonad = ProgramT InterpreterInstr (State InterpreterState)+ instance MonadError PrettyError InterpreterMonad where throwError = singleton . ErrorThrow catchError a c = singleton (ErrorCatch a c)@@ -416,7 +421,9 @@ -- See <http://docs.puppetlabs.com/puppetdb/2.3/api/wire_format/catalog_format_v5.html#data-type-edge> data PuppetEdge = PuppetEdge RIdentifier RIdentifier LinkType deriving Show --- | Wire format, see <http://docs.puppetlabs.com/puppetdb/1.5/api/wire_format/catalog_format.html>.+-- | Wire format+--+-- See <http://docs.puppetlabs.com/puppetdb/1.5/api/wire_format/catalog_format.html puppet reference>. data WireCatalog = WireCatalog { _wireCatalogNodename :: !NodeName , _wireCatalogVersion :: !Text
Puppet/Lens.hs view
@@ -11,8 +11,7 @@ , _PResourceReference , _PUndef , _PArray- -- * Parsing prism- -- * Lenses and Prisms for 'Statement's+ -- * Lenses and prims for 'Statement's , _Statements , _ResDecl , _ResDefaultDecl@@ -26,7 +25,7 @@ , _MainFuncDecl , _HigherOrderLambdaDecl , _DepDecl- -- * Lenses and Prisms for 'Expression's+ -- * Prim for 'Expression's , _Equal , _Different , _Not@@ -57,19 +56,29 @@ import Control.Lens +import Puppet.Parser (puppetParser) import Puppet.Parser.Types import Puppet.Interpreter.Types import Puppet.Interpreter.Pure import Puppet.Interpreter.Resolve+import qualified Puppet.Parser.PrettyPrinter() import qualified Data.Vector as V import qualified Data.HashMap.Strict as HM import Data.Tuple.Strict hiding (uncurry) import Control.Exception (SomeException, toException, fromException)+import qualified Data.Text as T+import Text.PrettyPrint.ANSI.Leijen (pretty) ---makePrisms ''Statement+import Text.Megaparsec (parse)+ makePrisms ''Expression +_PuppetParser :: Prism' T.Text (V.Vector Statement)+_PuppetParser = prism' (T.pack . unlines . V.toList . fmap (show . pretty)) $ \t -> case parse puppetParser "dummy" t of+ Left _ -> Nothing+ Right r -> Just r+ _PrettyError :: Prism' SomeException PrettyError _PrettyError = prism' toException fromException @@ -152,8 +161,6 @@ toU (PHash h) = UHash (V.fromList $ map (\(k,v) -> (Terminal (UString k) :!: Terminal (toU v))) $ HM.toList h) toU (PType _) = error "TODO, _PResolveValue PType undefined" --- | Extracts the statements from 'ClassDeclaration', 'DefineDeclaration',--- 'Node' and the spurious statements of 'TopContainer'. _Statements :: Lens' Statement [Statement] _Statements = lens (V.toList . sget) (\s v -> sset s (V.fromList v)) where
Puppet/NativeTypes/Helpers.hs view
@@ -4,7 +4,6 @@ module Puppet.NativeTypes.Helpers ( module Puppet.PP , ipaddr- -- smart constructor for NativeTypeMethods , nativetypemethods , paramname , rarray@@ -57,6 +56,7 @@ perror :: Doc -> Either PrettyError Resource perror = Left . PrettyError +-- | Smart constructor for 'NativeTypeMethods'. nativetypemethods :: [(T.Text, [T.Text -> NativeTypeValidate])] -> NativeTypeValidate -> NativeTypeMethods nativetypemethods def extraV = let params = fromKeys def@@ -98,7 +98,7 @@ newparams p = HM.filter def $ HM.union p defaults defaults = HM.empty --- | Helper function that runs a validor on a PArray+-- | Helper function that runs a validor on a 'PArray' runarray :: T.Text -> (T.Text -> PValue -> NativeTypeValidate) -> NativeTypeValidate runarray param func res = case res ^. rattributes . at param of Just (PArray x) -> V.foldM (flip (func param)) res x@@ -146,8 +146,8 @@ defaultvalue :: T.Text -> T.Text -> NativeTypeValidate defaultvalue value param = Right . over (rattributes . at param) (Just . fromMaybe (PString value)) --- | Checks that a given parameter, if set, is a 'ResolvedInt'. If it is a--- 'PString' it will attempt to parse it.+-- | Checks that a given parameter, if set, is a 'ResolvedInt'.+-- If it is a 'PString' it will attempt to parse it. integer :: T.Text -> NativeTypeValidate integer prm res = string prm res >>= integer' prm where@@ -163,8 +163,8 @@ Just v -> Right (res & rattributes . at param ?~ PNumber (fromIntegral v)) _ -> perror $ "Parameter" <+> paramname param <+> "must be an integer" --- | Copies the "name" value into the parameter if this is not set. It implies--- the `string` validator.+-- | Copies the "name" value into the parameter if this is not set.+-- It implies the `string` validator. nameval :: T.Text -> NativeTypeValidate nameval prm res = string prm res >>= \r -> case r ^. rattributes . at prm of
Puppet/NativeTypes/Mount.hs view
@@ -11,10 +11,10 @@ parameterfunctions = [("atboot" , [string, values ["true","false"]]) ,("blockdevice" , [string])- ,("device" , [string, mandatory])+ ,("device" , [string, mandatoryIfNotAbsent]) ,("dump" , [integer, inrange 0 2]) ,("ensure" , [defaultvalue "present", string, values ["present","absent","mounted"]])- ,("fstype" , [string, mandatory])+ ,("fstype" , [string, mandatoryIfNotAbsent]) ,("name" , [nameval]) ,("options" , [string]) ,("pass" , [defaultvalue "0", integer])
Puppet/NativeTypes/User.hs view
@@ -7,7 +7,8 @@ nativeUser :: (NativeTypeName, NativeTypeMethods) nativeUser = ("user", nativetypemethods parameterfunctions return) --- Autorequires: If Puppet is managing the user or user that owns a file, the file resource will autorequire them. If Puppet is managing any parent directories of a file, the file resource will autorequire them.+-- Autorequires: If Puppet is managing the user or user that owns a file, the file resource will autorequire them.+-- If Puppet is managing any parent directories of a file, the file resource will autorequire them. parameterfunctions :: [(T.Text, [T.Text -> NativeTypeValidate])] parameterfunctions = [("allowdupe" , [string, defaultvalue "false", values ["true","false"]])
Puppet/NativeTypes/ZoneRecord.hs view
@@ -9,7 +9,8 @@ nativeZoneRecord :: (NativeTypeName, NativeTypeMethods) nativeZoneRecord = ("zone_record", nativetypemethods parameterfunctions validateMandatories) --- Autorequires: If Puppet is managing the user or group that owns a file, the file resource will autorequire them. If Puppet is managing any parent directories of a file, the file resource will autorequire them.+-- Autorequires: If Puppet is managing the user or group that owns a file, the file resource will autorequire them.+-- If Puppet is managing any parent directories of a file, the file resource will autorequire them. parameterfunctions :: [(T.Text, [T.Text -> NativeTypeValidate])] parameterfunctions = [("name" , [nameval])
Puppet/PP.hs view
@@ -19,7 +19,7 @@ prettyToShow :: Doc -> String prettyToShow d = displayS (renderCompact d) "" --- | A rendering function that drops colors:+-- | A rendering function that drops colors. displayNocolor :: Doc -> String displayNocolor = flip displayS "" . dropEffects . renderPretty 0.4 180 where
Puppet/Parser.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE TupleSections #-}+ {-| Parse puppet source code from text. -} module Puppet.Parser ( -- * Runner runPParser -- * Parsers+ , Parser , puppetParser , expression , datatype@@ -558,6 +560,7 @@ -- | Heterogeneous chain (interleaving resource declarations with -- resource references)needs to be supported:+-- -- class { 'docker::service': } -> -- Class['docker'] chainableResources :: Parser [Statement]
Puppet/Parser/Types.hs view
@@ -48,6 +48,9 @@ DefineDecl(..), NodeDecl(..), VarAssignDecl(..),+ vadname,+ vadpos,+ vadvalue, MainFuncDecl(..), HigherOrderLambdaDecl(..), ResCollDecl(..)@@ -73,7 +76,7 @@ import Text.Megaparsec.Pos import Text.Regex.PCRE.String --- | Properly capitalizes resource types+-- | Properly capitalizes resource types. capitalizeRT :: Text -> Text capitalizeRT = T.intercalate "::" . map capitalize' . T.splitOn "::" where@@ -108,7 +111,7 @@ let p = (initialPos (T.unpack fl)) { sourceLine = mkPos $ fromIntegral (max 1 ln) } in (p :!: p) --- | High Order "lambdas"+-- | /High Order lambdas/. data LambdaFunc = LambEach | LambMap@@ -119,6 +122,7 @@ deriving (Eq, Show) -- | Lambda block parameters:+-- -- Currently only two types of block parameters are supported: -- single values and pairs. data LambdaParameters@@ -285,10 +289,10 @@ deriving (Eq, Show) data Virtuality- = Normal -- ^ Normal resource, that will be included in the catalog- | Virtual -- ^ Type for virtual resources- | Exported -- ^ Type for exported resources- | ExportedRealized -- ^ These are resources that are exported AND included in the catalogderiving (Generic, Eq, Show)+ = Normal -- ^ Normal resource, that will be included in the catalog.+ | Virtual -- ^ Type for virtual resources.+ | Exported -- ^ Type for exported resources.+ | ExportedRealized -- ^ These are resources that are exported AND included in the catalogderiving (Generic, Eq, Show). deriving (Eq, Show) data NodeDesc@@ -322,43 +326,60 @@ instance ToJSON LinkType where toJSON = String . rel2text --- | Resource declaration: e.g `file { mode => 755}`+-- | Resource declaration:+--+-- @ file { mode => 755} @ data ResDecl = ResDecl !Text !Expression !(V.Vector AttributeDecl) !Virtuality !PPosition deriving (Eq, Show) --- | Resource default: e.g `File { mode => 755 }`--- https://docs.puppetlabs.com/puppet/latest/reference/lang_defaults.html#language:-resource-default-statements+-- | Resource default:+--+-- @ File { mode => 755 } @+--+-- <https://docs.puppetlabs.com/puppet/latest/reference/lang_defaults.html#language:-resource-default-statements puppet reference>. data ResDefaultDecl = ResDefaultDecl !Text !(V.Vector AttributeDecl) !PPosition deriving (Eq, Show) --- | Resource override: e.g `File['title'] { mode => 755}`--- https://docs.puppetlabs.com/puppet/latest/reference/lang_resources_advanced.html#amending-attributes-with-a-resource-reference+-- | Resource override:+--+-- @ File['title'] { mode => 755} @+--+-- See <https://docs.puppetlabs.com/puppet/latest/reference/lang_resources_advanced.html#amending-attributes-with-a-resource-reference puppet reference>. data ResOverrideDecl = ResOverrideDecl !Text !Expression !(V.Vector AttributeDecl) !PPosition deriving (Eq, Show) --- | All types of conditional statements (@case@, @if@, etc.) are stored as an ordered list of pair (condition, statements)--- (interpreted as "if first cond is true, choose first statements, else take the next pair, check the condition ...")+-- | All types of conditional statements : @case@, @if@, ...+--+-- Stored as an ordered list of pair @ (condition, statements) @.+-- Interpreted as "if first cond is true, choose first statements, else take the next pair, check the condition ..." data ConditionalDecl = ConditionalDecl !(V.Vector (Pair Expression (V.Vector Statement))) !PPosition deriving (Eq, Show) data ClassDecl = ClassDecl !Text !(V.Vector (Pair (Pair Text (S.Maybe DataType)) (S.Maybe Expression))) !(S.Maybe Text) !(V.Vector Statement) !PPosition deriving (Eq, Show) data DefineDecl = DefineDecl !Text !(V.Vector (Pair (Pair Text (S.Maybe DataType)) (S.Maybe Expression))) !(V.Vector Statement) !PPosition deriving (Eq, Show) --- | A node is a collection of statements + maybe an inherit node+-- | A node is a collection of statements + maybe an inherit node. data NodeDecl = NodeDecl !NodeDesc !(V.Vector Statement) !(S.Maybe NodeDesc) !PPosition deriving (Eq, Show) --- | e.g $newvar = 'world'-data VarAssignDecl = VarAssignDecl !Text !Expression !PPosition deriving (Eq, Show)+-- | @ $newvar = 'world' @+data VarAssignDecl+ = VarAssignDecl+ { _vadname :: !Text+ , _vadvalue :: !Expression+ , _vadpos :: !PPosition+ } deriving (Eq, Show) data MainFuncDecl = MainFuncDecl !Text !(V.Vector Expression) !PPosition deriving (Eq, Show) -- | /Higher order function/ call. data HigherOrderLambdaDecl = HigherOrderLambdaDecl !HOLambdaCall !PPosition deriving (Eq, Show) --- | Resource Collector including exported collector (`<<| |>>`)--- e.g `User <| title == 'jenkins' |> { groups +> "docker"}`--- https://docs.puppetlabs.com/puppet/latest/reference/lang_collectors.html#language:-resource-collectors+-- | Resource Collector including exported collector (`\<\<| |>>`)+--+-- @ User \<| title == 'jenkins' |> { groups +> "docker"} @+--+-- See <https://docs.puppetlabs.com/puppet/latest/reference/lang_collectors.html#language:-resource-collectors puppet reference> data ResCollDecl = ResCollDecl !CollectorType !Text !SearchExpression !(V.Vector AttributeDecl) !PPosition deriving (Eq, Show) data DepDecl = DepDecl !(Pair Text Expression) !(Pair Text Expression) !LinkType !PPosition deriving (Eq, Show) --- | All the possible statements+-- | All possible statements. data Statement = ResourceDeclaration !ResDecl | ResourceDefaultDeclaration !ResDefaultDecl@@ -376,5 +397,5 @@ deriving (Eq, Show) makeClassy ''HOLambdaCall+makeLenses ''VarAssignDecl $(deriveToJSON defaultOptions ''DataType)-
Puppet/Stdlib.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE PatternGuards #-} module Puppet.Stdlib (stdlibFunctions) where import Control.Applicative@@ -27,6 +28,7 @@ import Puppet.Interpreter.Types import Puppet.Interpreter.Utils import Puppet.PP+import Puppet.Utils (text2Scientific) -- | Contains the implementation of the StdLib functions. stdlibFunctions :: Container ( [PValue] -> InterpreterMonad PValue )@@ -484,10 +486,12 @@ validateInteger :: [PValue] -> InterpreterMonad PValue validateInteger [] = throwPosError "validate_integer(): wrong number of arguments, must be > 0"-validateInteger x = mapM_ vb x >> return PUndef+validateInteger x = PUndef <$ mapM_ vb x where msg d = pretty d <+> "is not an integer."- vb (PNumber n) = unless (Scientific.isInteger n) $ throwPosError (msg (show n))+ check n = unless (Scientific.isInteger n) $ throwPosError (msg (show n))+ vb (PNumber n) = check n+ vb (PString s) | Just n <- text2Scientific s = check n vb a = throwPosError (msg a) pvalues :: PValue -> InterpreterMonad PValue
PuppetDB/Common.hs view
@@ -49,7 +49,7 @@ Nothing -> fmap Right initTestDB -- | Turns a 'FinalCatalog' and 'EdgeMap' into a document that can be--- serialized and fed to @puppet apply@.+ -- serialized and fed to @puppet apply@. generateWireCatalog :: NodeName -> FinalCatalog -> EdgeMap -> WireCatalog generateWireCatalog node cat edgemap = WireCatalog node "version" edges resources "uiid" where
PuppetDB/Dummy.hs view
@@ -2,6 +2,7 @@ -- responses. module PuppetDB.Dummy where +import Control.Monad.Except import Puppet.Interpreter.Types dummyPuppetDB :: Monad m => PuppetDBAPI m
README.adoc view
@@ -12,13 +12,21 @@ puppetresources -p /where/your/puppet/files/are -o node.name.com ``` -.Easy build instructions:+.Quick install instruction with stack ```bash+stack install language-puppet+```++.Build instructions:+```bash git clone https://github.com/bartavelle/language-puppet.git cd language-puppet-# Add ~/.local/bin to $PATH-ln -s stack-8.0.yaml stack.yaml-stack install+# Using nix+cabal2nix . > default.nix+nix-build shell.nix # or nix-shell+# Using stack+ln -s stack-9.yaml stack.yaml+stack build ``` == Puppetresources
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 1.3.10+version: 1.3.11 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/@@ -195,7 +195,7 @@ ghc-options: -Wall -rtsopts -funbox-strict-fields -threaded -with-rtsopts "-A2M" -eventlog -- ghc-prof-options: -auto-all -caf-all -fprof-auto build-depends: base- , Glob+ , Glob < 0.9 , aeson , bytestring , containers@@ -215,6 +215,19 @@ , unordered-containers , vector main-is: PuppetResources.hs++executable yera+ hs-source-dirs: progs+ extensions: BangPatterns, OverloadedStrings+ ghc-options: -Wall -rtsopts -threaded+ build-depends: base+ , language-puppet+ , optparse-applicative+ , text+ , strict-base-types+ , ansi-wl-pprint+ , unordered-containers+ main-is: yera.hs executable pdbquery hs-source-dirs: progs
progs/PuppetResources.hs view
@@ -38,7 +38,7 @@ import qualified Facter import Puppet.Daemon import Puppet.Lens-import Puppet.Parser+import Puppet.Parser hiding (Parser) import Puppet.Parser.PrettyPrinter (ppStatements) import Puppet.Parser.Types import Puppet.Preferences
+ progs/yera.hs view
@@ -0,0 +1,59 @@+module Main (main) where+ +import Options.Applicative+import Data.Monoid+import qualified Data.Text as T+import qualified Data.Either.Strict as S+import qualified Data.HashMap.Strict as HM+import Text.PrettyPrint.ANSI.Leijen (pretty)++import Puppet.Interpreter.Types+import Puppet.Interpreter.PrettyPrinter()+import Hiera.Server++data Config+ = Config+ { _filepath :: FilePath+ , _query :: String+ , _queryType :: HieraQueryType+ , _variables :: [(T.Text,T.Text)]+ }++readQT :: String -> Maybe HieraQueryType+readQT s+ = case s of+ "first" -> Just QFirst+ "unique" -> Just QUnique+ "hash" -> Just QHash+ _ -> Nothing++parseVariable :: String -> Either String (T.Text, T.Text)+parseVariable s =+ case break (=='=') s of+ ([], []) -> Left "Empty variable"+ ([], _) -> Left "Nothing on the left side of the = symbol"+ (_, []) -> Left "Nothing on the right side of the = symbol"+ (var, '=':val) -> Right (T.pack var, T.pack val)+ _ -> Left "???"++configParser :: Parser Config+configParser = Config <$> strOption (long "config" <> short 'c' <> metavar "CONFIG" <> value "hiera.yaml")+ <*> strOption (long "query" <> short 'q' <> metavar "QUERY")+ <*> option (maybeReader readQT) (long "querytype" <> short 't' <> metavar "QUERYTYPE" <> value QFirst <> help "values: first (default), unique, hash")+ <*> many (argument (eitherReader parseVariable) (metavar "VARIABLE" <> help "Variables, in the form key=value"))++configInfo :: ParserInfo Config+configInfo = info (configParser <**> helper) mempty++main :: IO ()+main = do+ Config fp query qtype vars <- execParser configInfo+ ehiera <- startHiera fp+ case ehiera of+ Left rr -> error rr+ Right hiera -> do+ r <- hiera (HM.fromList vars) (T.pack query) qtype+ case r of+ S.Left rr -> error (show rr)+ S.Right Nothing -> putStrLn "no match"+ S.Right (Just res) -> print (pretty res)
tests/Helpers.hs view
@@ -17,6 +17,7 @@ import Puppet.Stdlib import Control.Lens+import Control.Monad.Except import qualified Data.HashMap.Strict as HM import qualified Data.Maybe.Strict as S import Data.Text (Text, unpack)@@ -50,4 +51,3 @@ case stdlibFunctions ^? ix fname of Just f -> testsuite f Nothing -> fail ("Don't know this function: " ++ show fname)-
tests/hiera.hs view
@@ -34,26 +34,26 @@ let checkOutput v (S.Right x) = x @?= v checkOutput _ (S.Left rr) = assertFailure (show rr) hspec $ do- describe "lookup data without a key" $ do- it "returns an error when called with an empty string" $ q mempty "" Priority >>= checkOutput Nothing+ describe "lookup data without a key" $+ it "returns an error when called with an empty string" $ q mempty "" QFirst >>= checkOutput Nothing describe "lookup data without a valid key" $ do- it "returns an error when called with a non existent key [Priority]" $ q mempty "foo" Priority >>= checkOutput Nothing- it "returns an error when called with a non existent key [ArrayMerge]" $ q mempty "foo" ArrayMerge >>= checkOutput Nothing- it "returns an error when called with a non existent key [HashMerge]" $ q mempty "foo" HashMerge >>= checkOutput Nothing+ it "returns an error when called with a non existent key [QFirst]" $ q mempty "foo" QFirst >>= checkOutput Nothing+ it "returns an error when called with a non existent key [QUnique]" $ q mempty "foo" QUnique >>= checkOutput Nothing+ it "returns an error when called with a non existent key [QHash]" $ q mempty "foo" QHash >>= checkOutput Nothing describe "lookup data with no options" $ do- it "can get string data" $ q mempty "http_port" Priority >>= checkOutput (Just (PNumber 8080))- it "can get arrays" $ q mempty "ntp_servers" Priority >>= checkOutput (Just (PArray (V.fromList ["0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"])))- it "can get hashes" $ q mempty "users" Priority >>= checkOutput (Just (PHash users))+ it "can get string data" $ q mempty "http_port" QFirst >>= checkOutput (Just (PNumber 8080))+ it "can get arrays" $ q mempty "ntp_servers" QFirst >>= checkOutput (Just (PArray (V.fromList ["0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"])))+ it "can get hashes" $ q mempty "users" QFirst >>= checkOutput (Just (PHash users)) describe "lookup data with a scope" $ do- it "overrides some values" $ q vars "http_port" Priority >>= checkOutput (Just (PNumber 9090))- it "doesn't fail on others" $ q vars "global" Priority >>= checkOutput (Just "glob")- describe "json backend" $ do- it "resolves in json" $ q vars "testjson" Priority >>= checkOutput (Just "ok")+ it "overrides some values" $ q vars "http_port" QFirst >>= checkOutput (Just (PNumber 9090))+ it "doesn't fail on others" $ q vars "global" QFirst >>= checkOutput (Just "glob")+ describe "json backend" $+ it "resolves in json" $ q vars "testjson" QFirst >>= checkOutput (Just "ok") describe "deep interpolation" $ do- it "resolves in strings" $ q vars "interp1" Priority >>= checkOutput (Just (PString ("**" <> ndname <> "**")))- it "resolves in objects" $ q vars "testnode" Priority >>= checkOutput (Just (PHash (HM.fromList [("1",PString ("**" <> ndname <> "**")),("2",PString "nothing special")])))- it "resolves in arrays" $ q vars "arraytest" Priority >>= checkOutput (Just (PArray (V.fromList [PString "a", PString ndname, PString "c"])))+ it "resolves in strings" $ q vars "interp1" QFirst >>= checkOutput (Just (PString ("**" <> ndname <> "**")))+ it "resolves in objects" $ q vars "testnode" QFirst >>= checkOutput (Just (PHash (HM.fromList [("1",PString ("**" <> ndname <> "**")),("2",PString "nothing special")])))+ it "resolves in arrays" $ q vars "arraytest" QFirst >>= checkOutput (Just (PArray (V.fromList [PString "a", PString ndname, PString "c"]))) describe "other merge modes" $ do- it "catenates arrays" $ q vars "ntp_servers" ArrayMerge >>= checkOutput (Just (PArray (V.fromList ["2.ntp.puppetlabs.com","3.ntp.puppetlabs.com","0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"])))- it "puts single values in arrays" $ q vars "http_port" ArrayMerge >>= checkOutput (Just (PArray (V.fromList [PNumber 9090, PNumber 8080])))- it "merges hashes" $ q vars "users" HashMerge >>= checkOutput (Just (PHash (pusers <> users)))+ it "catenates arrays" $ q vars "ntp_servers" QUnique >>= checkOutput (Just (PArray (V.fromList ["2.ntp.puppetlabs.com","3.ntp.puppetlabs.com","0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"])))+ it "puts single values in arrays" $ q vars "http_port" QUnique >>= checkOutput (Just (PArray (V.fromList [PNumber 9090, PNumber 8080])))+ it "merges hashes" $ q vars "users" QHash >>= checkOutput (Just (PHash (pusers <> users)))