diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +language-puppet (1.3.18) UNRELEASED; urgency=medium + + * Added prefix and suffix functions (Fix #246) + + -- Simon Marechal Fri, 18 May 2018 11:42:19 +0200 + language-puppet (1.3.17) artful; urgency=medium * Loose upperbound for servant to include 0.13 * Loose upperbound for exceptions to include 0.10.0 diff --git a/language-puppet.cabal b/language-puppet.cabal --- a/language-puppet.cabal +++ b/language-puppet.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet -version: 1.3.17 +version: 1.3.18 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/ @@ -160,6 +160,7 @@ , transformers , unordered-containers , vector + , pcre-utils other-modules: DT.Parser ErbSpec EvalSpec @@ -174,6 +175,8 @@ Function.AssertPrivateSpec Function.JoinKeysToValuesSpec Function.LookupSpec + Function.SuffixSpec + Function.PrefixSpec Helpers InterpreterSpec Interpreter.CollectorSpec diff --git a/src/Puppet/Interpreter/Resolve.hs b/src/Puppet/Interpreter/Resolve.hs --- a/src/Puppet/Interpreter/Resolve.hs +++ b/src/Puppet/Interpreter/Resolve.hs @@ -668,6 +668,7 @@ UDTEnum ens -> DTEnum . NE.fromList . sconcat <$> traverse resolveExpressionStrings ens UDTAny -> pure DTAny UDTCollection -> pure DTCollection + UDTRegexp mr -> pure (DTRegexp mr) -- | Generates variable associations for evaluation of blocks. -- Each item corresponds to an iteration in the calling block. @@ -790,6 +791,9 @@ DTAny -> True DTCollection -> datatypeMatch (DTVariant (DTArray DTData 0 Nothing :| [DTHash DTScalar DTData 0 Nothing])) v DTPattern patterns -> maybe False (\str -> any (checkPattern (Text.encodeUtf8 str)) patterns) (v ^? _PString) + DTRegexp mr -> case v ^? _PRegexp of + Nothing -> False + Just cr -> maybe True (== cr) mr where checkPattern str (CompRegex _ ptrn) = case Regex.execute' ptrn str of diff --git a/src/Puppet/Language/Value.hs b/src/Puppet/Language/Value.hs --- a/src/Puppet/Language/Value.hs +++ b/src/Puppet/Language/Value.hs @@ -8,6 +8,7 @@ import Data.Aeson import Data.Aeson.Lens import Data.Aeson.TH +import qualified Data.HashMap.Strict as HM import Foreign.Ruby.Helpers import Puppet.Language.Core @@ -30,6 +31,7 @@ | DTEnum (NonEmpty Text) | DTAny | DTCollection + | DTRegexp (Maybe CompRegex) deriving (Show, Eq) instance Pretty DataType where @@ -51,6 +53,7 @@ DTEnum tx -> "Enum" <> list (foldMap (pure . ppline) tx) DTAny -> "Any" DTCollection -> "Collection" + DTRegexp mr -> "Regex" <> foldMap (brackets . pretty) mr where bounded :: (Pretty a, Pretty b) => Doc -> Maybe a -> Maybe b -> Doc bounded s ma mb = s <> case (ma, mb) of @@ -69,7 +72,8 @@ | PArray !(Vector PValue) | PHash !(Container PValue) | PNumber !Scientific - | PType DataType + | PType !DataType + | PRegexp !CompRegex deriving (Eq, Show) makePrisms ''PValue @@ -84,6 +88,7 @@ pretty (PArray v) = list (map pretty (toList v)) pretty (PHash g) = containerComma g pretty (PType dt) = pretty dt + pretty (PRegexp cr) = pretty cr instance IsString PValue where fromString = PString . toS @@ -109,6 +114,7 @@ parseJSON (String s) = return (PString s) parseJSON (Bool b) = return (PBoolean b) parseJSON (Array v) = fmap PArray (mapM parseJSON v) + parseJSON (Object o) | HM.size o == 1 && HM.keys o == ["regexp"] = o .: "regexp" parseJSON (Object o) = fmap PHash (mapM parseJSON o) instance ToJSON PValue where @@ -120,6 +126,7 @@ toJSON (PArray r) = Array (fmap toJSON r) toJSON (PHash x) = Object (fmap toJSON x) toJSON (PNumber n) = Number n + toJSON (PRegexp r) = object [("regexp", toJSON r)] instance ToRuby PValue where toRuby = toRuby . toJSON diff --git a/src/Puppet/Parser.hs b/src/Puppet/Parser.hs --- a/src/Puppet/Parser.hs +++ b/src/Puppet/Parser.hs @@ -670,6 +670,7 @@ <|> (reserved "Optional" *> (UDTOptional <$> brackets datatype)) <|> (UNotUndef <$ reserved "NotUndef") <|> (reserved "Variant" *> (UDTVariant . NE.fromList <$> brackets (datatype `sepBy1` symbolic ','))) + <|> (reserved "Regexp" *> (UDTRegexp <$> optional (brackets termRegexp))) -- while all the other cases are straightforward, it seems that the -- following syntax is a valid regexp for puppet: -- '^dqsqsdqs$' @@ -725,9 +726,49 @@ Just (tk, tv, Just [mi, mx]) -> return (UDTHash tk tv mi (Just mx)) Just (_, _, Just _) -> fail "Too many arguments to datatype Hash" dtExternal = - reserved "Stdlib::HTTPUrl" $> UDTData - <|> reserved "Stdlib::Absolutepath" $> UDTData + reserved "Stdlib::Absolutepath" $> UDTData + <|> reserved "Stdlib::Base32" $> UDTData + <|> reserved "Stdlib::Base64" $> UDTData + <|> reserved "Stdlib::Compat::Absolute_path" $> UDTData + <|> reserved "Stdlib::Compat::Array" $> UDTData + <|> reserved "Stdlib::Compat::Bool" $> UDTData + <|> reserved "Stdlib::Compat::Float" $> UDTData + <|> reserved "Stdlib::Compat::Hash" $> UDTData + <|> reserved "Stdlib::Compat::Integer" $> UDTData + <|> reserved "Stdlib::Compat::Ip_address" $> UDTData + <|> reserved "Stdlib::Compat::Ipv4" $> UDTData + <|> reserved "Stdlib::Compat::Ipv6" $> UDTData + <|> reserved "Stdlib::Compat::Numeric" $> UDTData + <|> reserved "Stdlib::Compat::String" $> UDTData + <|> reserved "Stdlib::Ensure::Service" $> UDTData + <|> reserved "Stdlib::Filemode" $> UDTData + <|> reserved "Stdlib::Filesource" $> UDTData + <|> reserved "Stdlib::Fqdn" $> UDTData + <|> reserved "Stdlib::Host" $> UDTData + <|> reserved "Stdlib::HTTPSUrl" $> UDTData + <|> reserved "Stdlib::HTTPUrl" $> UDTData + <|> reserved "Stdlib::IP::Address::Nosubnet" $> UDTData + <|> reserved "Stdlib::Ip_address" $> UDTData + <|> reserved "Stdlib::IP::Address" $> UDTData + <|> reserved "Stdlib::IP::Address::V4::CIDR" $> UDTData + <|> reserved "Stdlib::IP::Address::V4::Nosubnet" $> UDTData + <|> reserved "Stdlib::IP::Address::V4" $> UDTData + <|> reserved "Stdlib::IP::Address::V6::Alternative" $> UDTData + <|> reserved "Stdlib::IP::Address::V6::Compressed" $> UDTData + <|> reserved "Stdlib::IP::Address::V6::Full" $> UDTData + <|> reserved "Stdlib::IP::Address::V6::Nosubnet::Alternative" $> UDTData + <|> reserved "Stdlib::IP::Address::V6::Nosubnet::Compressed" $> UDTData + <|> reserved "Stdlib::IP::Address::V6::Nosubnet::Full" $> UDTData + <|> reserved "Stdlib::IP::Address::V6::Nosubnet" $> UDTData + <|> reserved "Stdlib::IP::Address::V6" $> UDTData + <|> reserved "Stdlib::Ipv4" $> UDTData + <|> reserved "Stdlib::Ipv6" $> UDTData + <|> reserved "Stdlib::MAC" $> UDTData + <|> reserved "Stdlib::Port::Privileged" $> UDTData + <|> reserved "Stdlib::Port" $> UDTData + <|> reserved "Stdlib::Port::Unprivileged" $> UDTData <|> reserved "Stdlib::Unixpath" $> UDTData + <|> reserved "Stdlib::Windowspath" $> UDTData <|> reserved "Nginx::ErrorLogSeverity" $> UDTData <|> reserved "Jenkins::Tunnel" $> UDTData <|> reserved "Systemd::Unit" $> UDTData diff --git a/src/Puppet/Parser/PrettyPrinter.hs b/src/Puppet/Parser/PrettyPrinter.hs --- a/src/Puppet/Parser/PrettyPrinter.hs +++ b/src/Puppet/Parser/PrettyPrinter.hs @@ -44,6 +44,7 @@ UDTEnum tx -> "Enum" <> list (foldMap (pure . pretty) tx) UDTAny -> "Any" UDTCollection -> "Collection" + UDTRegexp mr -> "Regexp" <> foldMap (brackets . pretty) mr where bounded :: (Pretty a, Pretty b) => Doc -> Maybe a -> Maybe b -> Doc bounded s ma mb = s <> case (ma, mb) of diff --git a/src/Puppet/Parser/Types.hs b/src/Puppet/Parser/Types.hs --- a/src/Puppet/Parser/Types.hs +++ b/src/Puppet/Parser/Types.hs @@ -179,6 +179,7 @@ | UDTEnum (NonEmpty Expression) | UDTAny | UDTCollection + | UDTRegexp (Maybe CompRegex) -- Tuple (NonEmpty DataType) Integer Integer -- DTDefault -- Struct TODO diff --git a/src/Puppet/Runner/Stdlib.hs b/src/Puppet/Runner/Stdlib.hs --- a/src/Puppet/Runner/Stdlib.hs +++ b/src/Puppet/Runner/Stdlib.hs @@ -91,7 +91,7 @@ -- parseyaml , ("pick", pick) , ("pick_default", pickDefault) - -- prefix + , ("prefix", prefix) -- private -- pw_hash -- range @@ -107,7 +107,7 @@ -- strtosaltedshar512 -- strftime , ("strip", stringArrayFunction Text.strip) - -- suffix + , ("suffix", suffix ) -- swapcase -- time -- to_bytes @@ -171,6 +171,25 @@ puppetAbs y = case y ^? _Number of Just x -> return $ _Number # abs x Nothing -> throwPosError ("abs(): Expects a number, not" <+> pretty y) + +suffix :: [PValue] -> InterpreterMonad PValue +suffix = foofix "suffix" (flip (<>)) + +prefix :: [PValue] -> InterpreterMonad PValue +prefix = foofix "prefix" (<>) + +foofix :: Doc -> (Text -> Text -> Text) -> [PValue] -> InterpreterMonad PValue +foofix nm f args = + case args of + [PHash h] -> pure (PHash h) + [PArray r] -> pure (PArray r) + [_] -> throwPosError (nm <> ": expects the first argument to be an array or a hash") + [PHash h, PString s] -> pure (PHash . HM.fromList . map (_1 %~ f s) . HM.toList $ h) + [PArray r, PString s] -> pure (PArray (r & traverse . _PString %~ f s)) + [PHash _, _] -> throwPosError (nm <> ": expects the second argument to be a string") + [PArray _, _] -> throwPosError (nm <> ": expects the second argument to be a string") + [_, _] -> throwPosError (nm <> ": expects the first argument to be an array or a hash") + _ -> throwPosError (nm <> ": expects two arguments") assertPrivate :: [PValue] -> InterpreterMonad PValue assertPrivate args = diff --git a/tests/DT/Parser.hs b/tests/DT/Parser.hs --- a/tests/DT/Parser.hs +++ b/tests/DT/Parser.hs @@ -4,6 +4,7 @@ import Test.Hspec.Megaparsec import Text.Megaparsec (parse) +import qualified Text.Regex.PCRE.ByteString.Utils as Regex spec :: Spec spec = do @@ -15,6 +16,9 @@ failed "String[4,5,6]" "String[5]" `parsed` UDTString (Just 5) Nothing "String[5,8]" `parsed` UDTString (Just 5) (Just 8) + "Regexp" `parsed` UDTRegexp Nothing + let Right foore = Regex.compile' Regex.compBlank Regex.execBlank "foo" + "Regexp[/foo/]" `parsed` UDTRegexp (Just (CompRegex "foo" foore)) it "accepts variables" $ pendingWith "to be fixed" *> parse datatype "?" "String[$var]" `shouldParse` UDTString (Just 5) Nothing describe "Stdlib::" $ do "Stdlib::HTTPUrl" `parsed` UDTData diff --git a/tests/Function/PrefixSpec.hs b/tests/Function/PrefixSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Function/PrefixSpec.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedLists #-} +module Function.PrefixSpec (spec, main) where + +import qualified Data.Text as T + +import Helpers + +main :: IO () +main = hspec spec + +fname :: Text +fname = "prefix" + +spec :: Spec +spec = withStdlibFunction fname $ \tester -> do + let checkError input expectederror = + case dummyEval (tester input) of + Left rr -> show (getError rr) `shouldStartWith` (T.unpack fname ++ ": " ++ expectederror) + Right _ -> expectationFailure "should have failed" + checkSuccess input expected = + case dummyEval (tester input) of + Left rr -> expectationFailure (show rr) + Right r -> r `shouldBe` expected + it "should fail with no argument" (checkError [] "expects two arguments") + it "should fail if the first argument isn't an array or hash" (checkError ["lol"] "expects the first argument to be an array or a hash") + it "should fail if the second argument isn't a string" $ do + checkError [PArray [], PNumber 1] "expects the second argument to be a string" + checkError [PArray [], PArray []] "expects the second argument to be a string" + it "should work with arrays" $ do + checkSuccess [ PArray []] (PArray []) + checkSuccess [ PArray [], ""] (PArray []) + checkSuccess [ PArray ["one"], "pre" ] (PArray ["preone"]) + checkSuccess [ PArray ["one","two","three"], "pre" ] (PArray ["preone","pretwo","prethree"]) + it "should work with hashes" $ do + checkSuccess [(PHash mempty)] (PHash mempty) + checkSuccess [(PHash mempty), ""] (PHash mempty) + checkSuccess [(PHash [("one", PNumber 5)] ), "pre" ] (PHash [("preone", PNumber 5)]) + checkSuccess [(PHash [("one", PNumber 5), ("two", "lol"), ("three", PNumber 7)]), "pre" ] (PHash [("preone", PNumber 5), ("pretwo", "lol"), ("prethree", PNumber 7)]) + diff --git a/tests/Function/SuffixSpec.hs b/tests/Function/SuffixSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Function/SuffixSpec.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedLists #-} +module Function.SuffixSpec (spec, main) where + +import qualified Data.Text as T + +import Helpers + +main :: IO () +main = hspec spec + +fname :: Text +fname = "suffix" + +spec :: Spec +spec = withStdlibFunction fname $ \tester -> do + let checkError input expectederror = + case dummyEval (tester input) of + Left rr -> show (getError rr) `shouldStartWith` (T.unpack fname ++ ": " ++ expectederror) + Right _ -> expectationFailure "should have failed" + checkSuccess input expected = + case dummyEval (tester input) of + Left rr -> expectationFailure (show rr) + Right r -> r `shouldBe` expected + it "should fail with no argument" (checkError [] "expects two arguments") + it "should fail if the first argument isn't an array or hash" (checkError ["lol"] "expects the first argument to be an array or a hash") + it "should fail if the second argument isn't a string" $ do + checkError [PArray [], PNumber 1] "expects the second argument to be a string" + checkError [PArray [], PArray []] "expects the second argument to be a string" + it "should work with arrays" $ do + checkSuccess [ PArray []] (PArray []) + checkSuccess [ PArray [], ""] (PArray []) + checkSuccess [ PArray ["one"], "post" ] (PArray ["onepost"]) + checkSuccess [ PArray ["one","two","three"], "post" ] (PArray ["onepost","twopost","threepost"]) + it "should work with hashes" $ do + checkSuccess [(PHash mempty)] (PHash mempty) + checkSuccess [(PHash mempty), ""] (PHash mempty) + checkSuccess [(PHash [("one", PNumber 5)] ), "post" ] (PHash [("onepost", PNumber 5)]) + checkSuccess [(PHash [("one", PNumber 5), ("two", "lol"), ("three", PNumber 7)]), "post" ] (PHash [("onepost", PNumber 5), ("twopost", "lol"), ("threepost", PNumber 7)]) + diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -15,6 +15,8 @@ import qualified Function.ShellquoteSpec import qualified Function.SizeSpec import qualified Function.SprintfSpec +import qualified Function.SuffixSpec +import qualified Function.PrefixSpec import qualified Interpreter.CollectorSpec import qualified Interpreter.IfSpec import qualified InterpreterSpec @@ -43,6 +45,8 @@ describe "The sprintf function" Function.SprintfSpec.spec describe "The each function" Function.EachSpec.spec describe "The lookup function" Function.LookupSpec.spec + describe "The suffix function" Function.SuffixSpec.spec + describe "The prefix function" Function.PrefixSpec.spec describe "stdlib functions" $ do describe "The assert_private function" Function.AssertPrivateSpec.spec describe "The join_keys_to_values function" Function.JoinKeysToValuesSpec.spec