diff --git a/Erb/Compute.hs b/Erb/Compute.hs --- a/Erb/Compute.hs +++ b/Erb/Compute.hs @@ -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 diff --git a/Puppet/Interpreter.hs b/Puppet/Interpreter.hs --- a/Puppet/Interpreter.hs +++ b/Puppet/Interpreter.hs @@ -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 diff --git a/Puppet/Parser.hs b/Puppet/Parser.hs --- a/Puppet/Parser.hs +++ b/Puppet/Parser.hs @@ -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 diff --git a/Puppet/Stdlib.hs b/Puppet/Stdlib.hs --- a/Puppet/Stdlib.hs +++ b/Puppet/Stdlib.hs @@ -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)) diff --git a/language-puppet.cabal b/language-puppet.cabal --- a/language-puppet.cabal +++ b/language-puppet.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet -version: 0.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 diff --git a/ruby/hrubyerb.rb b/ruby/hrubyerb.rb --- a/ruby/hrubyerb.rb +++ b/ruby/hrubyerb.rb @@ -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