language-puppet 0.10.1 → 0.10.2
raw patch · 6 files changed
+110/−94 lines, 6 filesdep ~aesondep ~ansi-wl-pprintdep ~attoparsec
Dependency ranges changed: aeson, ansi-wl-pprint, attoparsec, base16-bytestring, case-insensitive, containers, cryptohash, filecache, hashable, hruby, hslogger, hslua, http-conduit, http-types, iconv, lens, luautils, mtl, parsec, parsers, pcre-utils, process, regex-pcre-builtin, stm, text, time, transformers, unix, unordered-containers, vector
Files
- Erb/Compute.hs +9/−1
- Puppet/Interpreter.hs +6/−2
- Puppet/Parser.hs +3/−3
- Puppet/Stdlib.hs +52/−49
- language-puppet.cabal +34/−34
- ruby/hrubyerb.rb +6/−5
Erb/Compute.hs view
@@ -33,6 +33,8 @@ import Foreign hiding (void) import Foreign.Ruby +import Control.Lens+import Data.Tuple.Strict type RegisteredGetvariable = RValue -> RValue -> RValue -> RValue -> IO RValue foreign import ccall "wrapper" mkRegisteredGetvariable :: RegisteredGetvariable -> IO (FunPtr RegisteredGetvariable) @@ -150,10 +152,16 @@ computeTemplateWRuby fileinfo curcontext variables = freezeGC $ do rscp <- embedHaskellValue curcontext rvariables <- embedHaskellValue variables+ let varlist = variables ^. ix curcontext . scopeVariables o <- case fileinfo of Right fname -> do rfname <- toRuby fname- safeMethodCall "Controller" "runFromFile" [rfname,rscp,rvariables]+ erbBinding <- safeMethodCall "ErbBinding" "new" [rscp,rvariables]+ case erbBinding of+ Left x -> return (Left x)+ Right v -> do+ forM_ (itoList varlist) $ \(varname, (varval :!: _ :!: _)) -> toRuby varval >>= rb_iv_set v (T.unpack varname)+ safeMethodCall "Controller" "runFromFile" [rfname,v] Left content -> toRuby content >>= safeMethodCall "Controller" "runFromContent" . (:[]) freeHaskellValue rvariables freeHaskellValue rscp
Puppet/Interpreter.hs view
@@ -463,9 +463,12 @@ scopes . at scopename ?= basescope return scopename +dropInitialColons :: T.Text -> T.Text+dropInitialColons t = fromMaybe t (T.stripPrefix "::" t)+ expandDefine :: Resource -> InterpreterMonad [Resource] expandDefine r = do- let deftype = r ^. rid . itype+ let deftype = dropInitialColons (r ^. rid . itype) defname = r ^. rid . iname modulename = case T.splitOn "::" deftype of [] -> deftype@@ -497,7 +500,8 @@ -> Container PValue -> ClassIncludeType -> InterpreterMonad [Resource]-loadClass classname params cincludetype = do+loadClass rclassname params cincludetype = do+ let classname = dropInitialColons rclassname p <- use curPos -- check if the class has already been loaded -- http://docs.puppetlabs.com/puppet/3/reference/lang_classes.html#using-resource-like-declarations
Puppet/Parser.hs view
@@ -274,9 +274,9 @@ , [ Infix ( operator "==" >> return Equal ) AssocLeft , Infix ( operator "!=" >> return Different ) AssocLeft ]- , [ Infix ( operator ">" >> return MoreThan ) AssocLeft- , Infix ( operator ">=" >> return MoreEqualThan ) AssocLeft+ , [ Infix ( operator ">=" >> return MoreEqualThan ) AssocLeft , Infix ( operator "<=" >> return LessEqualThan ) AssocLeft+ , Infix ( operator ">" >> return MoreThan ) AssocLeft , Infix ( operator "<" >> return LessThan ) AssocLeft ] , [ Infix ( reserved "and" >> return And ) AssocLeft@@ -314,7 +314,7 @@ return [Node n st inheritance (p :!: pe) | n <- ns] puppetClassParameters :: Parser (V.Vector (Pair T.Text (S.Maybe Expression)))-puppetClassParameters = fmap V.fromList $ parens (var `sepBy` comma)+puppetClassParameters = fmap V.fromList $ parens (var `sepEndBy` comma) where toStrictMaybe (Just x) = S.Just x toStrictMaybe Nothing = S.Nothing
Puppet/Stdlib.hs view
@@ -20,10 +20,10 @@ import qualified Data.ByteString.Base16 as B16 stdlibFunctions :: Container ( [PValue] -> InterpreterMonad PValue )-stdlibFunctions = HM.fromList [ ("abs", puppetAbs)+stdlibFunctions = HM.fromList [ singleArgument "abs" puppetAbs , ("any2array", any2array) , ("base64", base64)- , ("bool2num", bool2num)+ , singleArgument "bool2num" bool2num , ("capitalize", stringArrayFunction (safeEmptyString (\t -> T.cons (toUpper (T.head t)) (T.tail t)))) , ("chomp", stringArrayFunction (T.dropWhileEnd (\c -> c == '\n' || c == '\r'))) , ("chop", stringArrayFunction (safeEmptyString T.init))@@ -32,12 +32,14 @@ , ("defined_with_params", const (throwPosError "defined_with_params can't be implemented with language-puppet")) , ("delete", delete) , ("delete_at", deleteAt)- , ("delete_undef_values", deleteUndefValues)+ , singleArgument "delete_undef_values" deleteUndefValues , ("downcase", stringArrayFunction T.toLower)- , ("getvar", getvar)- , ("is_domain_name", isDomainName)- , ("is_integer", isInteger)- , ("keys", keys)+ , singleArgument "getvar" getvar+ , ("getparam", const $ throwPosError "The getparam function is uncool and shall not be implemented in language-puppet")+ , singleArgument "is_array" isArray+ , singleArgument "is_domain_name" isDomainName+ , singleArgument "is_integer" isInteger+ , singleArgument "keys" keys , ("lstrip", stringArrayFunction T.stripStart) , ("merge", merge) , ("rstrip", stringArrayFunction T.stripEnd)@@ -50,6 +52,12 @@ , ("validate_string", validateString) ] +singleArgument :: T.Text -> (PValue -> InterpreterMonad PValue) -> (T.Text, [PValue] -> InterpreterMonad PValue )+singleArgument fname ifunc = (fname, ofunc)+ where+ ofunc [x] = ifunc x+ ofunc _ = throwPosError (ttext fname <> "(): Expects a single argument.")+ safeEmptyString :: (T.Text -> T.Text) -> T.Text -> T.Text safeEmptyString _ "" = "" safeEmptyString f x = f x@@ -67,12 +75,11 @@ Right r -> return r Left ms -> throwPosError ("Can't parse regexp" <+> pretty (URegexp p undefined) <+> ":" <+> text (show ms)) -puppetAbs :: [PValue] -> InterpreterMonad PValue-puppetAbs [y] = case y ^? pvnum of- Just (I x) -> return $ pvnum # I (abs x)- Just (D x) -> return $ pvnum # D (abs x)- Nothing -> throwPosError ("abs(): Expects a number, not" <+> pretty y)-puppetAbs _ = throwPosError "abs(): Takes a single argument"+puppetAbs :: PValue -> InterpreterMonad PValue+puppetAbs y = case y ^? pvnum of+ Just (I x) -> return $ pvnum # I (abs x)+ Just (D x) -> return $ pvnum # D (abs x)+ Nothing -> throwPosError ("abs(): Expects a number, not" <+> pretty y) any2array :: [PValue] -> InterpreterMonad PValue any2array [PArray v] = return (PArray v)@@ -92,26 +99,24 @@ _ -> throwPosError ("base64(): could not decode" <+> pretty pb) a -> throwPosError ("base64(): the first argument must be either 'encode' or 'decode', not" <+> ttext a) fmap PString (safeDecodeUtf8 r)- base64 _ = throwPosError "base64(): Expects 2 arguments" -bool2num :: [PValue] -> InterpreterMonad PValue-bool2num [PString ""] = return (PBoolean False)-bool2num [PString "1"] = return (PBoolean True)-bool2num [PString "t"] = return (PBoolean True)-bool2num [PString "y"] = return (PBoolean True)-bool2num [PString "true"] = return (PBoolean True)-bool2num [PString "yes"] = return (PBoolean True)-bool2num [PString "0"] = return (PBoolean False)-bool2num [PString "f"] = return (PBoolean False)-bool2num [PString "n"] = return (PBoolean False)-bool2num [PString "false"] = return (PBoolean False)-bool2num [PString "no"] = return (PBoolean False)-bool2num [PString "undef"] = return (PBoolean False)-bool2num [PString "undefined"] = return (PBoolean False)-bool2num [x@(PBoolean _)] = return x-bool2num [x] = throwPosError ("bool2num(): Can't convert" <+> pretty x <+> "to boolean")-bool2num _ = throwPosError "bool2num() expects a single argument"+bool2num :: PValue -> InterpreterMonad PValue+bool2num (PString "") = return (PBoolean False)+bool2num (PString "1") = return (PBoolean True)+bool2num (PString "t") = return (PBoolean True)+bool2num (PString "y") = return (PBoolean True)+bool2num (PString "true") = return (PBoolean True)+bool2num (PString "yes") = return (PBoolean True)+bool2num (PString "0") = return (PBoolean False)+bool2num (PString "f") = return (PBoolean False)+bool2num (PString "n") = return (PBoolean False)+bool2num (PString "false") = return (PBoolean False)+bool2num (PString "no") = return (PBoolean False)+bool2num (PString "undef") = return (PBoolean False)+bool2num (PString "undefined") = return (PBoolean False)+bool2num x@(PBoolean _) = return x+bool2num x = throwPosError ("bool2num(): Can't convert" <+> pretty x <+> "to boolean") puppetConcat :: [PValue] -> InterpreterMonad PValue puppetConcat [PArray a, PArray b] = return (PArray (a <> b))@@ -155,19 +160,20 @@ deleteAt [x,_] = throwPosError ("delete_at(): expects its first argument to be an array, not" <+> pretty x) deleteAt _ = throwPosError "delete_at(): expects 2 arguments" -deleteUndefValues :: [PValue] -> InterpreterMonad PValue-deleteUndefValues [PArray r] = return $ PArray $ V.filter (/= PUndef) r-deleteUndefValues [PHash h] = return $ PHash $ HM.filter (/= PUndef) h-deleteUndefValues [x] = throwPosError ("delete_undef_values(): Expects an Array or a Hash, not" <+> pretty x)-deleteUndefValues _ = throwPosError "delete_undef_values(): Expects a single argument"+deleteUndefValues :: PValue -> InterpreterMonad PValue+deleteUndefValues (PArray r) = return $ PArray $ V.filter (/= PUndef) r+deleteUndefValues (PHash h) = return $ PHash $ HM.filter (/= PUndef) h+deleteUndefValues x = throwPosError ("delete_undef_values(): Expects an Array or a Hash, not" <+> pretty x) -getvar :: [PValue] -> InterpreterMonad PValue-getvar [x] = resolvePValueString x >>= resolveVariable-getvar _ = throwPosError "getvar() expects a single argument"+getvar :: PValue -> InterpreterMonad PValue+getvar = resolvePValueString >=> resolveVariable +isArray :: PValue -> InterpreterMonad PValue+isArray (PArray _) = return (PBoolean True)+isArray _ = return (PBoolean False) -isDomainName :: [PValue] -> InterpreterMonad PValue-isDomainName [s] = do+isDomainName :: PValue -> InterpreterMonad PValue+isDomainName s = do rs <- resolvePValueString s let ndrs = if T.last rs == '.' then T.init rs@@ -179,16 +185,13 @@ && (T.last x /= '-') && T.all (\y -> isAlphaNum y || y == '-') x return $ PBoolean $ not (T.null rs) && T.length rs <= 255 && all checkPart prts-isDomainName _ = throwPosError "is_domain_name(): Should only take a single argument" -isInteger :: [PValue] -> InterpreterMonad PValue-isInteger [i] = return (PBoolean (not (isn't pvnum i)))-isInteger _ = throwPosError "is_integer(): Should only take a single argument"+isInteger :: PValue -> InterpreterMonad PValue+isInteger = return . PBoolean . not . isn't pvnum -keys :: [PValue] -> InterpreterMonad PValue-keys [PHash h] = return (PArray $ V.fromList $ map PString $ HM.keys h)-keys [x] = throwPosError ("keys(): Expects a Hash, not" <+> pretty x)-keys _ = throwPosError "keys(): expects a single argument"+keys :: PValue -> InterpreterMonad PValue+keys (PHash h) = return (PArray $ V.fromList $ map PString $ HM.keys h)+keys x = throwPosError ("keys(): Expects a Hash, not" <+> pretty x) merge :: [PValue] -> InterpreterMonad PValue merge [PHash a, PHash b] = return (PHash (b `HM.union` a))
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 0.10.1+version: 0.10.2 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/@@ -72,46 +72,46 @@ , Puppet.Interpreter.RubyRandom extensions: OverloadedStrings, BangPatterns if flag(hruby)- Build-depends: hruby+ Build-depends: hruby >= 0.1.1 && <0.2 CPP-Options: -DHRUBY ghc-options: -Wall -funbox-strict-fields ghc-prof-options: -auto-all -caf-all -- other-modules: build-depends: base ==4.6.*- , strict-base-types >= 0.2- , hashable- , unordered-containers- , text , bytestring- , vector- , parsec- , mtl- , lens- , parsers- , ansi-wl-pprint- , unix- , aeson- , luautils >= 0.1.1.0- , hslua- , transformers- , hslogger- , time- , filecache- , regex-pcre-builtin- , pcre-utils- , process- , iconv- , http-types- , http-conduit- , attoparsec- , case-insensitive- , cryptohash- , base16-bytestring- , containers- , stm- , hspec >=1.7.0 && <1.8.0- , yaml >=0.8.0 && <0.9+ , strict-base-types >= 0.2+ , hashable == 1.2.*+ , unordered-containers == 0.2.*+ , text == 0.11.*+ , vector == 0.10.*+ , parsec == 3.1.*+ , mtl == 2.1.*+ , lens >= 3.9 && < 4+ , parsers >= 0.9 && < 0.10+ , ansi-wl-pprint == 0.6.*+ , unix == 2.6.*+ , aeson == 0.6.*+ , luautils >= 0.1.1+ , hslua == 0.3.*+ , transformers == 0.3.*+ , hslogger == 1.2.*+ , time == 1.4.*+ , filecache >= 0.2.2 && < 0.3+ , regex-pcre-builtin >= 0.94.4+ , pcre-utils == 0.1.*+ , process == 1.1.*+ , iconv == 0.4.*+ , http-types == 0.8.*+ , http-conduit >= 1.9 && <1.10+ , attoparsec == 0.10.*+ , case-insensitive == 1.1.*+ , cryptohash >= 0.10 && < 0.12+ , base16-bytestring == 0.1.*+ , containers == 0.5.*+ , stm == 2.4.*+ , hspec >= 1.7.0 && <1.8.0+ , yaml >= 0.8.0 && <0.9 Test-Suite test-lexer hs-source-dirs: tests type: exitcode-stdio-1.0
ruby/hrubyerb.rb view
@@ -34,6 +34,7 @@ end class ErbBinding+ @options = {} def initialize(context,variables) @scope = Scope.new(context,variables) end@@ -54,13 +55,13 @@ end class Controller- def self.runFromFile(filename,context,variables)- self.runFromContent(IO.read(filename),context,variables)+ def self.runFromFile(filename,binding)+ self.runFromContent(IO.read(filename),binding) end- def self.runFromContent(content,context,variables)+ def self.runFromContent(content,binding) nerb = ERB.new(content, nil, "-")- binding = ErbBinding.new(context,variables).get_binding- nerb.result(binding)+ # binding = ErbBinding.new(context,variables).get_binding+ nerb.result(binding.get_binding) end end