summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimonMarechal <>2018-06-16 20:45:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-06-16 20:45:00 (GMT)
commit351e1b7cab501db55cf754f19f93e4320d1a863b (patch)
tree25997c28371b4aecaccb8ad8c8075fbc2892d619
parentb982d94e94c58ab3b0cacf7111caf9bab0600401 (diff)
version 1.3.181.3.18
-rw-r--r--CHANGELOG6
-rw-r--r--language-puppet.cabal5
-rw-r--r--src/Puppet/Interpreter/Resolve.hs4
-rw-r--r--src/Puppet/Language/Value.hs9
-rw-r--r--src/Puppet/Parser.hs45
-rw-r--r--src/Puppet/Parser/PrettyPrinter.hs1
-rw-r--r--src/Puppet/Parser/Types.hs1
-rw-r--r--src/Puppet/Runner/Stdlib.hs23
-rw-r--r--tests/DT/Parser.hs4
-rw-r--r--tests/Function/PrefixSpec.hs39
-rw-r--r--tests/Function/SuffixSpec.hs39
-rw-r--r--tests/Spec.hs4
12 files changed, 174 insertions, 6 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 69f9dfe..d7a4cb1 100644
--- 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 <bartavelle@gmail.com> 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
index e2126df..d5b49ac 100644
--- 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 @@ Test-Suite spec
, transformers
, unordered-containers
, vector
+ , pcre-utils
other-modules: DT.Parser
ErbSpec
EvalSpec
@@ -174,6 +175,8 @@ Test-Suite spec
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
index ed1d350..86aa22e 100644
--- a/src/Puppet/Interpreter/Resolve.hs
+++ b/src/Puppet/Interpreter/Resolve.hs
@@ -668,6 +668,7 @@ resolveDataType ud
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 @@ datatypeMatch dt v =
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
index 16ed3be..e47eb3e 100644
--- a/src/Puppet/Language/Value.hs
+++ b/src/Puppet/Language/Value.hs
@@ -8,6 +8,7 @@ import XPrelude
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 @@ data DataType
| DTEnum (NonEmpty Text)
| DTAny
| DTCollection
+ | DTRegexp (Maybe CompRegex)
deriving (Show, Eq)
instance Pretty DataType where
@@ -51,6 +53,7 @@ instance Pretty DataType where
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 @@ data PValue
| PArray !(Vector PValue)
| PHash !(Container PValue)
| PNumber !Scientific
- | PType DataType
+ | PType !DataType
+ | PRegexp !CompRegex
deriving (Eq, Show)
makePrisms ''PValue
@@ -84,6 +88,7 @@ instance Pretty PValue where
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 @@ instance FromJSON PValue where
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 @@ instance ToJSON PValue where
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
index fd73f50..7c78752 100644
--- a/src/Puppet/Parser.hs
+++ b/src/Puppet/Parser.hs
@@ -670,6 +670,7 @@ datatype = dtString
<|> (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 @@ datatype = dtString
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
index 9bc18ce..f6a99c7 100644
--- a/src/Puppet/Parser/PrettyPrinter.hs
+++ b/src/Puppet/Parser/PrettyPrinter.hs
@@ -44,6 +44,7 @@ instance Pretty UDataType where
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
index f3c17bb..259af5a 100644
--- a/src/Puppet/Parser/Types.hs
+++ b/src/Puppet/Parser/Types.hs
@@ -179,6 +179,7 @@ data UDataType
| 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
index dc28cef..ca3b69b 100644
--- a/src/Puppet/Runner/Stdlib.hs
+++ b/src/Puppet/Runner/Stdlib.hs
@@ -91,7 +91,7 @@ stdlibFunctions = HM.fromList [ singleArgument "abs" puppetAbs
-- parseyaml
, ("pick", pick)
, ("pick_default", pickDefault)
- -- prefix
+ , ("prefix", prefix)
-- private
-- pw_hash
-- range
@@ -107,7 +107,7 @@ stdlibFunctions = HM.fromList [ singleArgument "abs" puppetAbs
-- strtosaltedshar512
-- strftime
, ("strip", stringArrayFunction Text.strip)
- -- suffix
+ , ("suffix", suffix )
-- swapcase
-- time
-- to_bytes
@@ -172,6 +172,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 =
case args of
diff --git a/tests/DT/Parser.hs b/tests/DT/Parser.hs
index 0326dd7..e155048 100644
--- a/tests/DT/Parser.hs
+++ b/tests/DT/Parser.hs
@@ -4,6 +4,7 @@ import Helpers
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 @@ spec = do
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
index 0000000..a29719f
--- /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
index 0000000..bf63113
--- /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
index 982b3a1..297d204 100644
--- a/tests/Spec.hs
+++ b/tests/Spec.hs
@@ -15,6 +15,8 @@ import qualified Function.MergeSpec
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 @@ spec = do
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