Hello community,
here is the log from the commit of package ghc-language-puppet for
openSUSE:Factory checked in at 2017-05-18 20:50:44
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-language-puppet (Old)
and /work/SRC/openSUSE:Factory/.ghc-language-puppet.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-language-puppet"
Thu May 18 20:50:44 2017 rev:2 rq:495707 version:1.3.7
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-language-puppet/ghc-language-puppet.changes
2017-05-10 20:45:22.670361758 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-language-puppet.new/ghc-language-puppet.changes
2017-05-18 20:50:45.806571635 +0200
@@ -1,0 +2,10 @@
+Mon Mar 27 12:41:41 UTC 2017 - [email protected]
+
+- Update to version 1.3.7 with cabal2obs.
+
+-------------------------------------------------------------------
+Tue Mar 7 11:19:27 UTC 2017 - [email protected]
+
+- Update to version 1.3.6 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
language-puppet-1.3.5.1.tar.gz
New:
----
language-puppet-1.3.7.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-language-puppet.spec ++++++
--- /var/tmp/diff_new_pack.CO4Lfl/_old 2017-05-18 20:50:46.894418111 +0200
+++ /var/tmp/diff_new_pack.CO4Lfl/_new 2017-05-18 20:50:46.898417546 +0200
@@ -19,7 +19,7 @@
%global pkg_name language-puppet
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.3.5.1
+Version: 1.3.7
Release: 0
Summary: Tools to parse and evaluate the Puppet DSL
License: BSD-3-Clause
++++++ language-puppet-1.3.5.1.tar.gz -> language-puppet-1.3.7.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/CHANGELOG.markdown
new/language-puppet-1.3.7/CHANGELOG.markdown
--- old/language-puppet-1.3.5.1/CHANGELOG.markdown 2017-02-02
11:58:01.000000000 +0100
+++ new/language-puppet-1.3.7/CHANGELOG.markdown 2017-03-14
18:12:30.000000000 +0100
@@ -1,3 +1,14 @@
+# v1.3.7 (2017/03/14)
+
+* Add puppet `sprintf` function
+* Fix scientific2text (#196)
+
+# v1.3.6 (2017/02/27)
+
+* The `defined` function can now test variables
+* Fixed the `delete_at` function, added new tests, TBC
+* Fixed the `ensure_resource` function, so that its second argument can take
an array.
+
# v1.3.5.1 (2017/02/02)
* Version bumps for megaparsec & servant
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/Facter.hs
new/language-puppet-1.3.7/Facter.hs
--- old/language-puppet-1.3.5.1/Facter.hs 2016-05-30 10:47:29.000000000
+0200
+++ new/language-puppet-1.3.7/Facter.hs 2017-03-14 18:12:16.000000000 +0100
@@ -110,14 +110,16 @@
| otherwise = takeWhile (/= '.') lrelease
osfam | distid == "Ubuntu" = "Debian"
| otherwise = distid
- return [ ("lsbdistid" , distid)
- , ("operatingsystem" , distid)
- , ("lsbdistrelease" , lrelease)
- , ("operatingsystemrelease" , lrelease)
- , ("lsbmajdistrelease" , maj)
- , ("osfamily" , osfam)
- , ("lsbdistcodename" , getval "DISTRIB_CODENAME")
- , ("lsbdistdescription" , getval "DISTRIB_DESCRIPTION")
+ return [ ("lsbdistid" , distid)
+ , ("operatingsystem" , distid)
+ , ("lsbdistrelease" , lrelease)
+ , ("operatingsystemrelease" , lrelease)
+ , ("operatingsystemmajrelease" , lrelease)
+ , ("lsbmajdistrelease" , maj)
+ , ("lsbminordistrelease" , "")
+ , ("osfamily" , osfam)
+ , ("lsbdistcodename" , getval "DISTRIB_CODENAME")
+ , ("lsbdistdescription" , getval "DISTRIB_DESCRIPTION")
]
factMountPoints :: IO [(String, String)]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/Puppet/Interpreter/IO.hs
new/language-puppet-1.3.7/Puppet/Interpreter/IO.hs
--- old/language-puppet-1.3.5.1/Puppet/Interpreter/IO.hs 2016-06-09
11:10:16.000000000 +0200
+++ new/language-puppet-1.3.7/Puppet/Interpreter/IO.hs 2017-03-14
18:12:16.000000000 +0100
@@ -79,7 +79,6 @@
PuppetPaths -> runInstr (r ^. readerPuppetPaths)
GetNativeTypes -> runInstr (r ^. readerNativeTypes)
ErrorThrow d -> return (Left d, s, mempty)
- ErrorCatch _ _ -> thpe "ErrorCatch"
GetNodeName -> runInstr (r ^. readerNodename)
HieraQuery scps q t -> canFail ((r ^. readerHieraQuery)
scps q t)
PDBInformation -> pdbInformation pdb >>= runInstr
@@ -96,3 +95,9 @@
TraceEvent e -> (r ^. readerIoMethods .
ioTraceEvent) e >>= runInstr
IsIgnoredModule m -> runInstr (r ^.
readerIgnoredModules . contains m)
IsExternalModule m -> runInstr (r ^.
readerExternalModules . contains m)
+ -- on error, the program state is RESET and the logged messages
are dropped
+ ErrorCatch atry ahandle -> do
+ (eres, s', w) <- interpretMonad r s atry
+ case eres of
+ Left rr -> interpretMonad r s (ahandle rr >>= k)
+ Right x -> logStuff w (interpretMonad r s' (k x))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/language-puppet-1.3.5.1/Puppet/Interpreter/Resolve/Sprintf.hs
new/language-puppet-1.3.7/Puppet/Interpreter/Resolve/Sprintf.hs
--- old/language-puppet-1.3.5.1/Puppet/Interpreter/Resolve/Sprintf.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/language-puppet-1.3.7/Puppet/Interpreter/Resolve/Sprintf.hs
2017-03-14 18:12:16.000000000 +0100
@@ -0,0 +1,144 @@
+module Puppet.Interpreter.Resolve.Sprintf where
+
+import Control.Applicative
+import Control.Monad
+import Data.Attoparsec.Text
+import Data.Scientific (Scientific)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
+import qualified Data.Text.Lazy.Builder.Int as TB
+import qualified Data.Text.Lazy.Builder.Scientific as TB
+
+
+import Puppet.Interpreter.Types
+import Puppet.Interpreter.Utils
+import Puppet.Utils
+import Puppet.PP (pretty)
+import Puppet.Interpreter.PrettyPrinter()
+
+data Flag = Minus | Plus | Space | Zero | Hash
+ deriving (Show, Eq)
+
+data FLen = Lhh | Lh | Ll | Lll | LL | Lz | Lj | Lt
+ deriving (Show, Eq)
+
+data FType = TPct | Td | Tu | Tf | TF | Te | TE | Tg | TG | Tx | TX | To | Ts
| Tc | Tp | Ta | TA
+ deriving (Show, Eq)
+
+data PrintfFormat = PrintfFormat { _pfFlags :: [Flag]
+ , _pfWidth :: Maybe Int
+ , _pfPrec :: Maybe Int
+ , _pfLen :: Maybe FLen
+ , _pfType :: FType
+ } deriving (Show, Eq)
+
+data FormatStringPart = Raw T.Text
+ | Format PrintfFormat
+ deriving (Show, Eq)
+
+parseFormat :: T.Text -> [FormatStringPart]
+parseFormat t | T.null t = []
+ | T.null nxt = [Raw raw]
+ | otherwise = Raw raw : rformat
+ where
+ (raw, nxt) = T.break (== '%') t
+ tryNext = case parseFormat (T.tail nxt) of
+ (Raw nt : nxt') -> Raw (T.cons '%' nt) : nxt'
+ nxt' -> Raw (T.singleton '%') : nxt'
+ rformat = case parse format nxt of
+ Fail _ _ _ -> tryNext
+ Partial _ -> tryNext
+ Done remaining f -> Format f : parseFormat remaining
+
+flag :: Parser Flag
+flag = (Minus <$ char '-')
+ <|> (Plus <$ char '+')
+ <|> (Space <$ char ' ')
+ <|> (Zero <$ char '0')
+ <|> (Hash <$ char '#')
+
+lenModifier :: Parser FLen
+lenModifier = (Lhh <$ string "hh")
+ <|> (Lh <$ char 'h')
+ <|> (Lll <$ string "ll")
+ <|> (Ll <$ char 'l')
+ <|> (LL <$ char 'L')
+ <|> (Lz <$ char 'z')
+ <|> (Lj <$ char 'j')
+ <|> (Lt <$ char 't')
+
+ftype :: Parser FType
+ftype = (TPct <$ char '%')
+ <|> (Td <$ char 'd')
+ <|> (Td <$ char 'i')
+ <|> (Tu <$ char 'u')
+ <|> (Tf <$ char 'f')
+ <|> (TF <$ char 'F')
+ <|> (Te <$ char 'e')
+ <|> (TE <$ char 'E')
+ <|> (Tg <$ char 'g')
+ <|> (TG <$ char 'G')
+ <|> (Tx <$ char 'x')
+ <|> (TX <$ char 'X')
+ <|> (To <$ char 'o')
+ <|> (Ts <$ char 's')
+ <|> (Tc <$ char 'c')
+ <|> (Ta <$ char 'a')
+ <|> (Tp <$ char 'p')
+ <|> (TA <$ char 'A')
+
+format :: Parser PrintfFormat
+format = do
+ void $ char '%'
+ flags <- many flag
+ width <- optional decimal
+ prec <- optional $ do
+ void $ char '.'
+ decimal
+ len <- optional lenModifier
+ ft <- ftype
+ return (PrintfFormat flags width prec len ft)
+
+sprintf :: T.Text -> [PValue] -> InterpreterMonad PValue
+sprintf str oargs = PString . TL.toStrict . TB.toLazyText . mconcat <$> go
(parseFormat str) oargs
+ where
+ go (Raw x : xs) args = (TB.fromText x :) <$> go xs args
+ go (Format f : _) _ | Hash `elem` _pfFlags f = throwPosError "sprintf: the
# modifier is not supported"
+ go (Format f : xs) (arg : args) = do
+ let numeric = case arg of
+ PNumber n -> pure n
+ PString s -> maybe (throwError "sprintf: Don't know
how to convert this to a number") return (text2Scientific s)
+ _ -> throwError "sprintf: Don't know how to
convert this to a number"
+ flags = _pfFlags f
+ sh mkBuilder n | has Minus = TL.justifyLeft padlen ' '
(sprefix <> content)
+ | has Plus && has Zero = sprefix <> TL.justifyRight
mpadlen '0' content
+ | has Plus = TL.justifyRight padlen ' '
(sprefix <> content)
+ | has Zero = TL.justifyRight padlen '0'
content
+ | otherwise = TL.justifyRight padlen ' '
content
+ where
+ (mpadlen, sprefix) | Plus `elem` flags && n >= 0 = (padlen
- 1, "+")
+ | Space `elem` flags && n >= 0 = (padlen
- 1, " ")
+ | otherwise = (padlen, mempty)
+ padlen = maybe 0 fromIntegral (_pfWidth f)
+ has flg = flg `elem` flags
+ content = TB.toLazyText (mkBuilder n)
+ baseString <- case _pfType f of
+ Td -> sh (TB.formatScientificBuilder TB.Fixed
(Just 0)) <$> numeric
+ Tf -> sh (TB.formatScientificBuilder TB.Fixed
(_pfPrec f)) <$> numeric
+ TF -> sh (TB.formatScientificBuilder TB.Fixed
(_pfPrec f)) <$> numeric
+ Tg -> sh (TB.formatScientificBuilder TB.Generic
(_pfPrec f)) <$> numeric
+ TG -> sh (TB.formatScientificBuilder TB.Generic
(_pfPrec f)) <$> numeric
+ Te -> sh (TB.formatScientificBuilder TB.Exponent
(_pfPrec f)) <$> numeric
+ TE -> sh (TB.formatScientificBuilder TB.Exponent
(_pfPrec f)) <$> numeric
+ Tx -> sh (TB.hexadecimal . (truncate :: Scientific
-> Integer)) <$> numeric
+ TX -> sh (TB.hexadecimal . (truncate :: Scientific
-> Integer)) <$> numeric
+ Ts -> return $ case arg of
+ PString s -> TL.fromStrict s
+ _ -> TL.pack (show (pretty arg))
+ _ -> throwPosError "sprintf: not yet supported"
+ (TB.fromLazyText baseString :) <$> go xs args
+ go [] [] = return []
+ go _ [] = throwPosError "sprintf: not enough arguments"
+ go [] _ = [] <$ let msg = "sprintf: too many arguments" in checkStrict msg
msg
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/language-puppet-1.3.5.1/Puppet/Interpreter/Resolve.hs
new/language-puppet-1.3.7/Puppet/Interpreter/Resolve.hs
--- old/language-puppet-1.3.5.1/Puppet/Interpreter/Resolve.hs 2016-05-30
13:47:20.000000000 +0200
+++ new/language-puppet-1.3.7/Puppet/Interpreter/Resolve.hs 2017-03-14
18:12:16.000000000 +0100
@@ -29,15 +29,6 @@
fixResourceName
) where
-import Puppet.Interpreter.PrettyPrinter ()
-import Puppet.Interpreter.RubyRandom
-import Puppet.Interpreter.Types
-import Puppet.Interpreter.Utils
-import Puppet.Parser.Types
-import Puppet.Paths
-import Puppet.PP
-import Puppet.Utils
-
import Control.Lens
import Control.Monad
import Control.Monad.Operational (singleton)
@@ -45,8 +36,8 @@
import Data.Aeson hiding ((.=))
import Data.Aeson.Lens hiding (key)
import Data.Bits
-import Data.ByteString (ByteString)
-import Data.ByteArray (convert)
+import Data.ByteArray (convert)
+import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import Data.CaseInsensitive (mk)
@@ -54,18 +45,28 @@
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
-import Data.Maybe (mapMaybe,fromMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Maybe.Strict as S
import Data.Scientific
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Tuple.Strict as S
import qualified Data.Vector as V
-import Data.Version (parseVersion)
+import Data.Version (Version (..), parseVersion)
import Text.ParserCombinators.ReadP (readP_to_S)
import qualified Text.PrettyPrint.ANSI.Leijen as PP
import Text.Regex.PCRE.ByteString.Utils
+import Puppet.Interpreter.PrettyPrinter ()
+import Puppet.Interpreter.RubyRandom
+import Puppet.Interpreter.Types
+import Puppet.Interpreter.Utils
+import Puppet.Interpreter.Resolve.Sprintf (sprintf)
+import Puppet.Parser.Types
+import Puppet.Paths
+import Puppet.PP
+import Puppet.Utils
+
sha1 :: ByteString -> ByteString
sha1 = convert . (hash :: ByteString -> Digest SHA1)
@@ -95,7 +96,7 @@
-- we can't use _PString, because of dependency cycles
toStr (k,v) = case v of
PString x -> Just (k,x)
- _ -> Nothing
+ _ -> Nothing
toplevels = map (_1 %~ ("::" <>)) $ getV "::"
locals = getV ctx
vars = HM.fromList (toplevels <> locals)
@@ -191,7 +192,7 @@
(PString sa, PString sb) -> mk sa == mk sb
-- TODO, check if array / hash equality should be recursed
-- for case insensitive matching
- _ -> ra == rb
+ _ -> ra == rb
-- | The main resolution function : turns an 'Expression' into a 'PValue',
-- if possible.
@@ -244,7 +245,7 @@
PHash h -> do
ridx <- resolveExpressionString idx
case h ^. at ridx of
- Just _ -> return (PBoolean True)
+ Just _ -> return (PBoolean True)
Nothing -> return (PBoolean False)
PArray ar -> do
ridx <- resolveExpression idx
@@ -263,7 +264,7 @@
checkStrict
("Look up for an hash with the unknown key '" <> ttext
ridx <> "' for" <+> pretty (PHash h))
("Can't find index '" <> ttext ridx <> "' in" <+> pretty
(PHash h))
- return "undef"
+ return PUndef
PArray ar -> do
ridx <- resolveExpression idx
i <- case ridx ^? _Integer of
@@ -294,9 +295,9 @@
ra <- resolveExpression a
rb <- resolveExpression b
case (ra, rb) of
- (PHash ha, PHash hb) -> return (PHash (ha <> hb))
+ (PHash ha, PHash hb) -> return (PHash (ha <> hb))
(PArray ha, PArray hb) -> return (PArray (ha <> hb))
- _ -> binaryOperation a b (+)
+ _ -> binaryOperation a b (+)
resolveExpression (Substraction a b) = binaryOperation a b (-)
resolveExpression (Division a b) = do
ra <- resolveExpressionNumber a
@@ -380,10 +381,10 @@
-- | Turns a 'PValue' into a 'Bool', as explained in the reference
-- documentation.
pValue2Bool :: PValue -> Bool
-pValue2Bool PUndef = False
+pValue2Bool PUndef = False
pValue2Bool (PString "") = False
pValue2Bool (PBoolean x) = x
-pValue2Bool _ = True
+pValue2Bool _ = True
-- | This resolve function calls at the expression level.
resolveFunction :: T.Text -> V.Vector Expression -> InterpreterMonad PValue
@@ -406,7 +407,7 @@
resolveFunction fname args = mapM resolveExpression (V.toList args) >>=
resolveFunction' fname . map undefEmptyString
where
undefEmptyString PUndef = PString ""
- undefEmptyString x = x
+ undefEmptyString x = x
resolveFunction' :: T.Text -> [PValue] -> InterpreterMonad PValue
resolveFunction' "defined" [PResourceReference "class" cn] = do
@@ -421,15 +422,24 @@
checkStrict "The use of the 'defined' function is a code smell."
"The 'defined' function is not allowed in strict mode."
t <- resolvePValueString ut
- -- case 1, netsted thingie
- nestedStuff <- use nestedDeclarations
- if has (ix (TopDefine, t)) nestedStuff || has (ix (TopClass, t))
nestedStuff
- then return (PBoolean True)
- else do -- case 2, loadeded class
- lc <- use loadedClasses
- if has (ix t) lc
+ if (not (T.null t) && T.head t == '$') -- variable test
+ then do
+ scps <- use scopes
+ scp <- getScopeName
+ return $ PBoolean $ case getVariable scps scp (T.tail t) of
+ Left _ -> False
+ Right _ -> True
+ else do -- resource test
+ -- case 1, nested thingie
+ nestedStuff <- use nestedDeclarations
+ if has (ix (TopDefine, t)) nestedStuff || has (ix (TopClass, t))
nestedStuff
then return (PBoolean True)
- else fmap PBoolean (isNativeType t)
+ else do -- case 2, loaded class
+ lc <- use loadedClasses
+ if has (ix t) lc
+ then return (PBoolean True)
+ else fmap PBoolean (isNativeType t)
+
resolveFunction' "defined" x = throwPosError ("defined(): expects a single
resource reference, type or class name, and not" <+> pretty x)
resolveFunction' "fail" x = throwPosError ("fail:" <+> pretty x)
resolveFunction' "inline_template" [] = throwPosError "inline_template():
Expects at least one argument"
@@ -450,7 +460,7 @@
Right x -> fmap PString (safeDecodeUtf8 x)
case ptarget of
PArray a -> fmap PArray (traverse sub a)
- s -> sub s
+ s -> sub s
resolveFunction' "regsubst" _ = throwPosError "regsubst(): Expects 3 or 4
arguments"
resolveFunction' "split" [psrc, psplt] = do
src <- fmap T.encodeUtf8 (resolvePValueString psrc)
@@ -497,15 +507,18 @@
a <- resolvePValueString pa
b <- resolvePValueString pb
let parser x = case filter (null . Prelude.snd) (readP_to_S parseVersion
(T.unpack x)) of
- ( (v, _) : _ ) -> return v
- _ -> throwPosError ("Could not parse this string as a
version:" <+> ttext x)
- va <- parser a
- vb <- parser b
+ ( (v, _) : _ ) -> v
+ _ -> Version [] [] -- fallback :(
+ va = parser a
+ vb = parser b
return $ PString $ case compare va vb of
EQ -> "0"
LT -> "-1"
GT -> "1"
resolveFunction' "versioncmp" _ = throwPosError "versioncmp(): Expects two
arguments"
+-- | Simplified implementation of sprintf
+resolveFunction' "sprintf" (PString str:args) = sprintf str args
+resolveFunction' "sprintf" _ = throwPosError "sprintf(): Expects a string as
its first argument"
-- some custom functions
resolveFunction' "pdbresourcequery" [q] = pdbresourcequery q Nothing
resolveFunction' "pdbresourcequery" [q,k] = fmap Just (resolvePValueString k)
>>= pdbresourcequery q
@@ -538,7 +551,7 @@
Nothing -> throwPosError
("pdbresourcequery strange error, could not find key" <+> ttext ky <+> "in" <+>
pretty (PHash h))
extractSubHash _ x = throwPosError ("pdbresourcequery strange error,
expected a hash, had" <+> pretty x)
case mkey of
- Nothing -> return (PArray rv)
+ Nothing -> return (PArray rv)
(Just k) -> fmap PArray (V.mapM (extractSubHash k) rv)
calcTemplate :: (T.Text -> Either T.Text T.Text) -> PValue -> InterpreterMonad
T.Text
@@ -573,9 +586,9 @@
mkSE (RNonEqualitySearch a b) = fmap QNot (mkSE (REqualitySearch a b))
mkSE (REqualitySearch a (PString b)) = [QEqual (mkFld a) b]
mkSE _ = []
- mkFld "tag" = RTag
+ mkFld "tag" = RTag
mkFld "title" = RTitle
- mkFld z = RParameter z
+ mkFld z = RParameter z
-- | Checks whether a given 'Resource' matches a 'RSearchExpression'. Note
-- that the expression doesn't check for type, so you must filter the
@@ -589,21 +602,21 @@
checkSearchExpression (REqualitySearch "title" v) r =
let nameequal = puppetEquality v (PString (r ^. rid . iname))
aliasequal = case r ^. rattributes . at "alias" of
- Just a -> puppetEquality v a
+ Just a -> puppetEquality v a
Nothing -> False
in nameequal || aliasequal
checkSearchExpression (REqualitySearch attributename v) r =
case r ^. rattributes . at attributename of
- Nothing -> False
+ Nothing -> False
Just (PArray x) -> F.any (flip puppetEquality v) x
- Just x -> puppetEquality x v
+ 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
+ Nothing -> True
Just (PArray x) -> not (F.all (flip puppetEquality v) x)
- Just x -> not (puppetEquality x v)
+ Just x -> not (puppetEquality x v)
-- | Generates variable associations for evaluation of blocks. Each item
-- corresponds to an iteration in the calling block.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/Puppet/Interpreter/Types.hs
new/language-puppet-1.3.7/Puppet/Interpreter/Types.hs
--- old/language-puppet-1.3.5.1/Puppet/Interpreter/Types.hs 2016-06-09
11:10:16.000000000 +0200
+++ new/language-puppet-1.3.7/Puppet/Interpreter/Types.hs 2017-03-14
18:12:16.000000000 +0100
@@ -74,6 +74,7 @@
, EdgeMap
-- * Classes
, MonadThrowPos(..)
+ , MonadError(..)
-- * definitions
, metaparameters
, showPos
@@ -137,6 +138,8 @@
instance Exception PrettyError
+instance Pretty PrettyError where
+ pretty = getError
data PValue = PBoolean !Bool
| PUndef
@@ -180,9 +183,9 @@
deriving (Show, Eq)
instance FromJSON Strictness where
- parseJSON (Bool True) = pure Strict
+ parseJSON (Bool True) = pure Strict
parseJSON (Bool False) = pure Permissive
- parseJSON _ = mzero
+ parseJSON _ = mzero
data RSearchExpression = REqualitySearch !Text !PValue
| RNonEqualitySearch !Text !PValue
@@ -513,7 +516,7 @@
where
chk (Left x) = Left x
chk (Right x) = case fromJSON x of
- Error rr -> Left rr
+ Error rr -> Left rr
Success suc -> Right suc
@@ -626,7 +629,7 @@
[ "<", flds, val ] -> QL <$> parseJSON flds <*> parseJSON val
[">=", flds, val ] -> QGE <$> parseJSON flds <*> parseJSON val
["<=", flds, val ] -> QLE <$> parseJSON flds <*> parseJSON val
- x -> fail ("unknown query" ++ show x)
+ x -> fail ("unknown query" ++ show x)
parseJSON _ = fail "Expected an array"
instance ToJSON FactField where
@@ -641,13 +644,13 @@
parseJSON _ = fail "Can't parse fact field"
instance ToJSON NodeField where
- toJSON NName = "name"
+ toJSON NName = "name"
toJSON (NFact t) = toJSON [ "fact", t ]
instance FromJSON NodeField where
parseJSON (Array xs) = case V.toList xs of
["fact", x] -> NFact <$> parseJSON x
- _ -> fail "Invalid field syntax"
+ _ -> fail "Invalid field syntax"
parseJSON (String "name") = pure NName
parseJSON _ = fail "invalid field"
@@ -676,7 +679,7 @@
instance FromJSON RIdentifier where
parseJSON (Object v) = RIdentifier <$> v .: "type" <*> v .: "title"
- parseJSON _ = fail "invalid resource"
+ parseJSON _ = fail "invalid resource"
instance ToJSON RIdentifier where
toJSON (RIdentifier t n) = object [("type", String t), ("title", String n)]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/Puppet/Interpreter.hs
new/language-puppet-1.3.7/Puppet/Interpreter.hs
--- old/language-puppet-1.3.5.1/Puppet/Interpreter.hs 2017-01-30
15:03:34.000000000 +0100
+++ new/language-puppet-1.3.7/Puppet/Interpreter.hs 2017-03-14
18:12:16.000000000 +0100
@@ -911,6 +911,7 @@
checkStrict "The use of the 'ensure_resource' function is a code smell."
"The 'ensure_resource' function is not allowed in strict mode."
ensureResource' t params title
+ensureResource [t, PArray arr, params] = concat <$> mapM (\r -> ensureResource
[t, r, params]) (V.toList arr)
ensureResource [t,title] = ensureResource [t,title,PHash mempty]
ensureResource [_, PString _, PHash _] = throwPosError "ensureResource(): The
first argument must be a string."
ensureResource [PString _, _, PHash _] = throwPosError "ensureResource(): The
second argument must be a string."
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/Puppet/Puppetlabs.hs
new/language-puppet-1.3.7/Puppet/Puppetlabs.hs
--- old/language-puppet-1.3.5.1/Puppet/Puppetlabs.hs 2016-05-30
13:47:20.000000000 +0200
+++ new/language-puppet-1.3.7/Puppet/Puppetlabs.hs 2017-03-14
18:12:16.000000000 +0100
@@ -27,6 +27,8 @@
extFun :: [(FilePath, Text, [PValue] -> InterpreterMonad PValue)]
extFun = [ ("/apache", "bool2httpd", apacheBool2httpd)
, ("/docker", "docker_run_flags", mockDockerRunFlags)
+ , ("/jenkins", "jenkins_port", mockJenkinsPort)
+ , ("/jenkins", "jenkins_prefix", mockJenkinsPrefix)
, ("/postgresql", "postgresql_acls_to_resources_hash", pgAclsToHash)
, ("/postgresql", "postgresql_password", pgPassword)
, ("/extlib", "random_password", randomPassword)
@@ -66,6 +68,16 @@
randomPassword _ = throwPosError "expect one single string arguments"
+-- | To be implemented if needed
+mockJenkinsPrefix :: MonadThrowPos m => [PValue] -> m PValue
+mockJenkinsPrefix [] = return $ PString ""
+mockJenkinsPrefix arg@_ = throwPosError $ "expect no argument" <+> pretty arg
+
+-- | To be implemented if needed
+mockJenkinsPort :: MonadThrowPos m => [PValue] -> m PValue
+mockJenkinsPort [] = return $ PString "8080"
+mockJenkinsPort arg@_ = throwPosError $ "expect no argument" <+> pretty arg
+
mockCacheData :: MonadThrowPos m => [PValue] -> m PValue
mockCacheData [_, _, b] = return b
mockCacheData arg@_ = throwPosError $ "expect 3 string arguments" <+> pretty
arg
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/Puppet/Stdlib.hs
new/language-puppet-1.3.7/Puppet/Stdlib.hs
--- old/language-puppet-1.3.5.1/Puppet/Stdlib.hs 2016-09-12
09:27:48.000000000 +0200
+++ new/language-puppet-1.3.7/Puppet/Stdlib.hs 2017-03-14 18:12:16.000000000
+0100
@@ -55,8 +55,8 @@
-- dos2unix
, ("downcase", stringArrayFunction T.toLower)
, singleArgument "empty" _empty
- -- ensure_packages
- -- ensure_resource
+ -- ensure_packages (in main interpreter module)
+ -- ensure_resource (in main interpreter module)
, singleArgument "flatten" flatten
-- floor
-- fqdn_rand_string
@@ -264,7 +264,7 @@
lr = V.length r
s1 = V.slice 0 n r
s2 = V.slice (n+1) (lr - n - 1) r
- in if V.length r >= n
+ in if V.length r <= n
then throwPosError ("delete_at(): Out
of bounds access detected, tried to remove index" <+> pretty z <+> "wheras the
array only has" <+> string (show lr) <+> "elements")
else return (PArray (s1 <> s2))
_ -> throwPosError ("delete_at(): The second
argument must be an integer, not" <+> pretty z)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/Puppet/Utils.hs
new/language-puppet-1.3.7/Puppet/Utils.hs
--- old/language-puppet-1.3.5.1/Puppet/Utils.hs 2016-06-09 11:10:16.000000000
+0200
+++ new/language-puppet-1.3.7/Puppet/Utils.hs 2017-03-14 18:12:16.000000000
+0100
@@ -1,3 +1,4 @@
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE LambdaCase #-}
-- | Those are utility functions, most of them being pretty much self
-- explanatory.
@@ -30,7 +31,6 @@
import Data.Scientific
import Control.Exception
import Control.Lens
-import Data.Aeson.Lens
import qualified Data.Yaml as Y
text2Scientific :: T.Text -> Maybe Scientific
@@ -39,9 +39,9 @@
Right s -> Just s
scientific2text :: Scientific -> T.Text
-scientific2text n = T.pack $ case n ^? _Integer of
- Just i -> show i
- _ -> show n
+scientific2text n = T.pack $ case floatingOrInteger n of
+ Left r -> show (r :: Double)
+ Right i -> show (i :: Integer)
strictifyEither :: Either a b -> S.Either a b
strictifyEither (Left x) = S.Left x
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/PuppetDB/Dummy.hs
new/language-puppet-1.3.7/PuppetDB/Dummy.hs
--- old/language-puppet-1.3.5.1/PuppetDB/Dummy.hs 2016-05-30
10:58:27.000000000 +0200
+++ new/language-puppet-1.3.7/PuppetDB/Dummy.hs 2017-03-14 18:12:16.000000000
+0100
@@ -16,4 +16,3 @@
(const (return [] ))
(throwError "not implemented")
(\_ _ -> return [] )
-
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/language-puppet.cabal
new/language-puppet-1.3.7/language-puppet.cabal
--- old/language-puppet-1.3.5.1/language-puppet.cabal 2017-02-02
11:58:23.000000000 +0100
+++ new/language-puppet-1.3.7/language-puppet.cabal 2017-03-14
18:12:16.000000000 +0100
@@ -2,7 +2,7 @@
-- documentation, see http://haskell.org/cabal/users-guide/
name: language-puppet
-version: 1.3.5.1
+version: 1.3.7
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/
@@ -15,7 +15,7 @@
build-type: Simple
cabal-version: >=1.8
-Tested-With: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
+Tested-With: GHC == 7.10.3, GHC == 8.0.1
extra-source-files:
CHANGELOG.markdown
@@ -45,6 +45,7 @@
, Puppet.Interpreter.PrettyPrinter
, Puppet.Interpreter.Pure
, Puppet.Interpreter.Resolve
+ , Puppet.Interpreter.Resolve.Sprintf
, Puppet.Interpreter.Types
, Puppet.Interpreter.Utils
, Puppet.Lens
@@ -176,13 +177,16 @@
extensions: OverloadedStrings
build-depends:
language-puppet,base,strict-base-types,lens,text,hspec,unordered-containers,megaparsec,vector,scientific,mtl
other-modules: Function.ShellquoteSpec
+ Function.SprintfSpec
Function.SizeSpec
Function.MergeSpec
Function.EachSpec
+ Function.DeleteAtSpec
Function.AssertPrivateSpec
Function.JoinKeysToValuesSpec
InterpreterSpec
Interpreter.CollectorSpec
+ Interpreter.IfSpec
Helpers
main-is: Spec.hs
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/language-puppet-1.3.5.1/tests/Function/DeleteAtSpec.hs
new/language-puppet-1.3.7/tests/Function/DeleteAtSpec.hs
--- old/language-puppet-1.3.5.1/tests/Function/DeleteAtSpec.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/language-puppet-1.3.7/tests/Function/DeleteAtSpec.hs 2017-03-14
18:12:16.000000000 +0100
@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedLists #-}
+module Function.DeleteAtSpec (spec, main) where
+
+import Test.Hspec
+
+import Data.Monoid
+
+import Puppet.Interpreter.Pure
+import Puppet.Interpreter.Types
+
+import Helpers
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = withStdlibFunction "delete_at" $ \deleteAtFunc -> do
+ let evalArgs' = dummyEval . deleteAtFunc
+ narray = PArray . fmap PNumber
+ check a b res = case evalArgs' [narray a, PNumber b] of
+ Left rr -> expectationFailure (show rr)
+ Right res' -> res' `shouldBe` narray res
+ checkError args ins = case evalArgs' args of
+ Left rr -> show rr `shouldContain` ins
+ Right r -> expectationFailure ("Should have
errored, received this instead: " <> show r)
+ it "should error with invalid arguments" $ do
+ checkError [] "expects 2 arguments"
+ checkError [PNumber 1] "expects 2 arguments"
+ checkError ["foo", "bar"] "expects its first argument to be an array"
+ checkError [ narray [0,1,2], PNumber 3 ] "Out of bounds access"
+ it "should work otherwise" $ do
+ check [0,1,2] 1 [0,2]
+ it "should work for negative positions" $ do
+ pending
+ check [0,1,2] (-1) [0,1]
+ check [0,1,2] (-4) [0,1,2]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/language-puppet-1.3.5.1/tests/Function/SprintfSpec.hs
new/language-puppet-1.3.7/tests/Function/SprintfSpec.hs
--- old/language-puppet-1.3.5.1/tests/Function/SprintfSpec.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/language-puppet-1.3.7/tests/Function/SprintfSpec.hs 2017-03-14
18:12:16.000000000 +0100
@@ -0,0 +1,60 @@
+module Function.SprintfSpec (spec, main) where
+
+import Test.Hspec
+import Data.Text (Text)
+import Control.Monad
+import qualified Data.Vector as V
+import Data.Monoid
+
+import Puppet.Interpreter.Pure
+import Puppet.Interpreter.Resolve
+import Puppet.Interpreter.Types
+import Puppet.Parser.Types
+import Puppet.PP
+
+main :: IO ()
+main = hspec spec
+
+evalArgs :: [Expression] -> Either PrettyError Text
+evalArgs = dummyEval . resolveValue . UFunctionCall "sprintf" . V.fromList
+ >=> \pv -> case pv of
+ PString s -> return s
+ _ -> Left ("Expected a string, not " <> PrettyError (pretty
pv))
+
+checkSuccess :: [Expression] -> Text -> Expectation
+checkSuccess args res =
+ case evalArgs args of
+ Left rr -> expectationFailure (show rr)
+ Right res' -> res' `shouldBe` res
+checkError :: [Expression] -> String -> Expectation
+checkError args msg =
+ case evalArgs args of
+ Left rr -> show rr `shouldContain` msg
+ Right r -> expectationFailure ("Should have errored, received this
instead: " <> show r)
+
+spec :: Spec
+spec = do
+ it "should fail with no argument" (checkError [] "Expects a string as its
first argument")
+ it "should succeed with one argument" (checkSuccess ["hello"] "hello") --
puppet sprintf accepts one arg
+ it "should work with multiple arguments" (checkSuccess ["hello %s %s",
"world", "!"] "hello world !")
+ it "should work with one string argument" (checkSuccess ["hello %s",
"world"] "hello world" )
+ it "should work with one int argument" (checkSuccess ["hello %d", 10]
"hello 10" )
+ it "should fail if arg is not provided" (checkError ["hello %s"] "not
enough arguments")
+ it "should fail when a wrong format instruction is used" (checkError
["hello %d", "world"] "Don't know how to convert this to a number" )
+ it "should fail when a wrong format instruction is used" (checkError
["hello %f", "world"] "Don't know how to convert this to a number" )
+ it "should work with one int argument" (checkSuccess ["hello %f", 1.0]
"hello 1.0" )
+ it "should work with one int argument" (checkSuccess ["hello %.1f", 1.23]
"hello 1.2" )
+ it "should pad with zeroes" (checkSuccess ["hello %03d", 10] "hello 010")
+ it "should pad with spaces" (checkSuccess ["hello % 3d", 10] "hello 10")
+ it "should format integers" (checkSuccess ["%+05d", 23] "+0023")
+ it "should format floats" (checkSuccess ["%+.2f", 2.7182818284590451]
"+2.72")
+ it "should format large floats" (pendingWith "Minor formatting difference"
>> checkSuccess ["%+.2e", 27182818284590451] "+2.72e+16")
+ it "should work with " (checkSuccess ["%5d" , 5] " 5")
+ it "should work with 0" (checkSuccess ["%05d" , 5] "00005")
+ it "should work with - " (checkSuccess ["%-5d" , 5] "5 ")
+ it "should work with -0" (checkSuccess ["%-05d" , 5] "5 ")
+ it "should work with + " (checkSuccess ["%+5d" , 5] " +5")
+ it "should work with + 0" (checkSuccess ["%+05d" , 5] "+0005")
+ it "should work with +- " (checkSuccess ["%+-5d" , 5] "+5 ")
+ it "should work with +-0" (checkSuccess ["%+-05d", 5] "+5 ")
+ it "should perform more complex formatting" (pendingWith "# is not yet
supported" >> checkSuccess [ "<%.8s:%#5o %#8X (%-8s)>", "overlongstring", 23,
48879, "foo" ] "<overlong: 027 0XBEEF (foo )>")
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/tests/Interpreter/IfSpec.hs
new/language-puppet-1.3.7/tests/Interpreter/IfSpec.hs
--- old/language-puppet-1.3.5.1/tests/Interpreter/IfSpec.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/language-puppet-1.3.7/tests/Interpreter/IfSpec.hs 2017-03-14
18:12:16.000000000 +0100
@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedLists #-}
+-- | Directly ported from puppet specs
+module Interpreter.IfSpec (spec) where
+
+import Test.Hspec
+
+import Control.Lens
+import Control.Monad.Except
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Helpers
+import Puppet.Interpreter.Types
+
+{-
+shouldReturn :: [Text] -> [PValue] -> Expectation
+shouldReturn content expectedMessages = do
+ cat <- case runExcept (getCatalog (T.unlines content)) of
+ Left rr -> fail rr
+ Right x -> return x
+ _foo cat
+-}
+
+shouldFail :: [Text] -> Expectation
+shouldFail content = let cat :: Either String FinalCatalog
+ cat = runExcept (getCatalog (T.unlines content))
+ in cat `shouldSatisfy` has _Left
+
+shouldNotFail :: [Text] -> Expectation
+shouldNotFail content = let cat :: Either String FinalCatalog
+ cat = runExcept (getCatalog (T.unlines content))
+ in cat `shouldSatisfy` has _Right
+
+spec :: Spec
+spec = do
+ it "doesn't enter false conditions" $ shouldNotFail
+ [ "if (false) { fail ':(' }" ]
+ it "enters true conditions" $ shouldFail
+ [ "if (true) { fail ':(' }" ]
+ it "not (unknown variable) is true" $ shouldFail
+ [ "if (!$::unknown123) { fail ':(' }" ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.5.1/tests/Spec.hs
new/language-puppet-1.3.7/tests/Spec.hs
--- old/language-puppet-1.3.5.1/tests/Spec.hs 2016-02-22 10:57:50.000000000
+0100
+++ new/language-puppet-1.3.7/tests/Spec.hs 2017-03-14 18:12:16.000000000
+0100
@@ -8,6 +8,9 @@
import qualified Function.EachSpec
import qualified Function.AssertPrivateSpec
import qualified Function.JoinKeysToValuesSpec
+import qualified Function.DeleteAtSpec
+import qualified Interpreter.IfSpec
+import qualified Function.SprintfSpec
main :: IO ()
main = hspec spec
@@ -18,11 +21,14 @@
describe "Collector" InterpreterSpec.collectorSpec
describe "Class include" InterpreterSpec.classIncludeSpec
describe "Collector (puppet tests)" Interpreter.CollectorSpec.spec
+ describe "If" Interpreter.IfSpec.spec
describe "Puppet functions" $ do
describe "The shellquote function" Function.ShellquoteSpec.spec
+ describe "The sprintf function" Function.SprintfSpec.spec
describe "The each function" Function.EachSpec.spec
describe "stdlib functions" $ do
describe "The assert_private function" Function.AssertPrivateSpec.spec
describe "The join_keys_to_values function"
Function.JoinKeysToValuesSpec.spec
describe "The merge function" Function.MergeSpec.spec
describe "The size function" Function.SizeSpec.spec
+ describe "The delete_at function" Function.DeleteAtSpec.spec
