Hello community,
here is the log from the commit of package ghc-language-puppet for
openSUSE:Factory checked in at 2017-08-31 20:57:04
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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 Aug 31 20:57:04 2017 rev:3 rq:513417 version:1.3.8.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-language-puppet/ghc-language-puppet.changes
2017-05-18 20:50:45.806571635 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-language-puppet.new/ghc-language-puppet.changes
2017-08-31 20:57:06.050043645 +0200
@@ -1,0 +2,5 @@
+Thu Jul 27 14:08:07 UTC 2017 - [email protected]
+
+- Update to version 1.3.8.1.
+
+-------------------------------------------------------------------
Old:
----
language-puppet-1.3.7.tar.gz
New:
----
language-puppet-1.3.8.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-language-puppet.spec ++++++
--- /var/tmp/diff_new_pack.Op7lNK/_old 2017-08-31 20:57:06.817935753 +0200
+++ /var/tmp/diff_new_pack.Op7lNK/_new 2017-08-31 20:57:06.821935192 +0200
@@ -19,7 +19,7 @@
%global pkg_name language-puppet
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.3.7
+Version: 1.3.8.1
Release: 0
Summary: Tools to parse and evaluate the Puppet DSL
License: BSD-3-Clause
++++++ language-puppet-1.3.7.tar.gz -> language-puppet-1.3.8.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/CHANGELOG.markdown
new/language-puppet-1.3.8.1/CHANGELOG.markdown
--- old/language-puppet-1.3.7/CHANGELOG.markdown 2017-03-14
18:12:30.000000000 +0100
+++ new/language-puppet-1.3.8.1/CHANGELOG.markdown 2017-07-21
12:04:15.000000000 +0200
@@ -1,3 +1,13 @@
+# v1.3.8.1 (2017/07/21)
+
+* Fix haddocks error (#208)
+
+# v1.3.8 (2017/07/20)
+
+* Add support for calling Functions in Strings (#199)
+* Add $facts hash for Puppet 4 (#198)
+* Initial support for datatype syntax (#206)
+
# v1.3.7 (2017/03/14)
* Add puppet `sprintf` function
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Daemon.hs
new/language-puppet-1.3.8.1/Puppet/Daemon.hs
--- old/language-puppet-1.3.7/Puppet/Daemon.hs 2017-01-12 07:15:51.000000000
+0100
+++ new/language-puppet-1.3.8.1/Puppet/Daemon.hs 2017-06-22
13:15:37.000000000 +0200
@@ -28,6 +28,7 @@
import System.Log.Handler (setFormatter)
import qualified System.Log.Handler.Simple as LOG (streamHandler)
import qualified System.Log.Logger as LOG
+import qualified Text.Megaparsec as P
import Erb.Compute
import Hiera.Server
@@ -184,7 +185,7 @@
cnt <- T.readFile fname
o <- case runPParser fname cnt of
Right r -> traceEventIO ("Stopped parsing " ++ fname) >> return
(S.Right r)
- Left rr -> traceEventIO ("Stopped parsing " ++ fname ++ " (failure: "
++ show rr ++ ")") >> return (S.Left (show rr))
+ Left rr -> traceEventIO ("Stopped parsing " ++ fname ++ " (failure: "
++ show rr ++ ")") >> return (S.Left (P.parseErrorPretty rr))
traceEventIO ("STOP parsing " ++ fname)
return o
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/language-puppet-1.3.7/Puppet/Interpreter/PrettyPrinter.hs
new/language-puppet-1.3.8.1/Puppet/Interpreter/PrettyPrinter.hs
--- old/language-puppet-1.3.7/Puppet/Interpreter/PrettyPrinter.hs
2017-01-12 07:15:51.000000000 +0100
+++ new/language-puppet-1.3.8.1/Puppet/Interpreter/PrettyPrinter.hs
2017-06-22 13:04:21.000000000 +0200
@@ -50,6 +50,7 @@
pretty (PResourceReference t n) = capitalize t <> brackets (text (T.unpack
n))
pretty (PArray v) = list (map pretty (V.toList v))
pretty (PHash g) = containerComma g
+ pretty (PType dt) = pretty dt
instance Pretty TopLevelType where
pretty TopNode = dullyellow (text "node")
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Interpreter/Resolve.hs
new/language-puppet-1.3.8.1/Puppet/Interpreter/Resolve.hs
--- old/language-puppet-1.3.7/Puppet/Interpreter/Resolve.hs 2017-03-14
18:12:16.000000000 +0100
+++ new/language-puppet-1.3.8.1/Puppet/Interpreter/Resolve.hs 2017-06-22
13:11:40.000000000 +0200
@@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
-- | This module is all about converting and resolving foreign data into
-- the fully exploitable corresponding data type. The main use case is the
-- conversion of 'Expression' to 'PValue'.
@@ -26,7 +27,8 @@
hfSetvars,
hfRestorevars,
toNumbers,
- fixResourceName
+ fixResourceName,
+ datatypeMatch
) where
import Control.Lens
@@ -45,7 +47,8 @@
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
-import Data.Maybe (fromMaybe, mapMaybe)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Maybe (fromMaybe, mapMaybe,
catMaybes)
import qualified Data.Maybe.Strict as S
import Data.Scientific
import qualified Data.Text as T
@@ -285,6 +288,9 @@
Left (_,rr) -> throwPosError ("Could not match" <+> pretty
v <+> ":" <+> string rr)
Right Nothing -> checkCond xs
Right (Just _) -> resolveExpression ce
+ checkCond ((SelectorType dt :!: ce) : xs) = if datatypeMatch dt rese
+ then resolveExpression ce
+ else checkCond xs
checkCond ((SelectorValue uv :!: ce) : xs) = do
rv <- resolveValue uv
if puppetEquality rese rv
@@ -712,3 +718,40 @@
PHash hh -> return $ PHash $ HM.fromList $ map Prelude.fst
$ filter Prelude.snd $ Prelude.zip (HM.toList hh) res
x -> throwPosError ("Can't iterate on this data type:" <+>
pretty x)
x -> throwPosError ("This type of function is not supported yet by
language-puppet!" <+> pretty x)
+
+-- | Checks that a value matches a puppet datatype
+datatypeMatch :: DataType -> PValue -> Bool
+datatypeMatch dt v
+ = case dt of
+ DTType -> has _PType v
+ DTUndef -> v == PUndef
+ NotUndef -> v /= PUndef
+ DTString mmin mmax -> boundedBy _PString T.length mmin mmax
+ DTInteger mmin mmax -> boundedBy (_PNumber . to toBoundedInteger .
_Just) id mmin mmax
+ DTFloat mmin mmax -> boundedBy _PNumber toRealFloat mmin mmax
+ DTBoolean -> has _PBoolean v
+ DTArray sdt mi mmx -> container (_PArray . to V.toList) (datatypeMatch
sdt) mi mmx
+ DTHash kt sdt mi mmx -> container (_PHash . to itoList) (\(k,a)
->
datatypeMatch kt (PString k) && datatypeMatch sdt a) mi mmx
+ DTScalar -> datatypeMatch (DTVariant (DTInteger Nothing
Nothing :| [DTString Nothing Nothing, DTBoolean])) v
+ DTData -> datatypeMatch (DTVariant (DTScalar :| [DTArray
DTData 0 Nothing, DTHash DTScalar DTData 0 Nothing])) v
+ DTOptional sdt -> datatypeMatch (DTVariant (DTUndef :| [sdt])) v
+ DTVariant sdts -> any (`datatypeMatch` v) sdts
+ DTEnum lst -> maybe False (`elem` lst) (v ^? _PString)
+ DTAny -> True
+ DTCollection -> datatypeMatch (DTVariant (DTArray DTData 0
Nothing :| [DTHash DTScalar DTData 0 Nothing])) v
+ DTPattern patterns -> maybe False (\str -> any (checkPattern
(T.encodeUtf8 str)) patterns) (v ^? _PString)
+ where
+ checkPattern str (CompRegex _ ptrn)
+ = case execute' ptrn str of
+ Right (Just _) -> True
+ _ -> False
+ container :: Fold PValue [a] -> (a -> Bool) -> Int -> Maybe Int -> Bool
+ container f c mi mmx =
+ let lst = v ^. f
+ ln = length lst
+ in ln >= mi && (fmap (ln <=) mmx /= Just False) && all c lst
+ boundedBy :: Ord b => Fold PValue a -> (a -> b) -> Maybe b -> Maybe b ->
Bool
+ boundedBy prm f mmin mmax
+ = fromMaybe False $ do
+ vr <- f <$> v ^? prm
+ return $ and $ catMaybes [fmap (vr >=) mmin, fmap (vr <=) mmax]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Interpreter/Types.hs
new/language-puppet-1.3.8.1/Puppet/Interpreter/Types.hs
--- old/language-puppet-1.3.7/Puppet/Interpreter/Types.hs 2017-03-14
18:12:16.000000000 +0100
+++ new/language-puppet-1.3.8.1/Puppet/Interpreter/Types.hs 2017-06-22
10:15:07.000000000 +0200
@@ -41,7 +41,17 @@
, HasInterpreterState(..)
, InterpreterState(InterpreterState)
-- * Sum types
+ -- ** PValue
, PValue(..)
+ , _PType
+ , _PBoolean
+ , _PString
+ , _PResourceReference
+ , _PArray
+ , _PHash
+ , _PNumber
+ , _PUndef
+ -- ** Misc
, CurContainerDesc(..)
, ResourceCollectorType(..)
, RSearchExpression(..)
@@ -148,6 +158,7 @@
| PArray !(V.Vector PValue)
| PHash !(Container PValue)
| PNumber !Scientific
+ | PType DataType
deriving (Eq, Show)
instance IsString PValue where
@@ -270,7 +281,7 @@
, _readerGetStatement :: TopLevelType -> Text -> m (S.Either
PrettyError Statement)
, _readerGetTemplate :: Either Text T.Text -> InterpreterState ->
InterpreterReader m -> m (S.Either PrettyError T.Text)
, _readerPdbApi :: PuppetDBAPI m
- , _readerExternalFunc :: Container ([PValue] -> InterpreterMonad PValue)
+ , _readerExternalFunc :: Container ([PValue] -> InterpreterMonad
PValue) -- ^ external func such as stdlib or puppetlabs
, _readerNodename :: Text
, _readerHieraQuery :: HieraQueryFunc m
, _readerIoMethods :: IoMethods m
@@ -485,7 +496,7 @@
makeClassy ''NodeInfo
makeClassy ''WireCatalog
makeClassy ''FactInfo
-
+makePrisms ''PValue
class Monad m => MonadThrowPos m where
throwPosError :: Doc -> m a
@@ -531,6 +542,7 @@
parseJSON (Object o) = fmap PHash (TR.mapM parseJSON o)
instance ToJSON PValue where
+ toJSON (PType t) = toJSON t
toJSON (PBoolean b) = Bool b
toJSON PUndef = Null
toJSON (PString s) = String s
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Interpreter/Utils.hs
new/language-puppet-1.3.8.1/Puppet/Interpreter/Utils.hs
--- old/language-puppet-1.3.7/Puppet/Interpreter/Utils.hs 2017-01-12
07:15:51.000000000 +0100
+++ new/language-puppet-1.3.8.1/Puppet/Interpreter/Utils.hs 2017-06-14
10:52:51.000000000 +0200
@@ -31,7 +31,10 @@
initialState facts settings = InterpreterState baseVars initialclass mempty
[ContRoot] dummyppos mempty [] []
where
callervars = HM.fromList [("caller_module_name", PString "::" :!:
dummyppos :!: ContRoot), ("module_name", PString "::" :!: dummyppos :!:
ContRoot)]
- factvars = fmap (\x -> x :!: initialPPos "facts" :!: ContRoot) facts
+ factvars =
+ -- add the `facts` key:
https://docs.puppet.com/puppet/4.10/lang_facts_and_builtin_vars.html#accessing-facts-from-puppet-code
+ let facts' = HM.insert "facts" (PHash facts) facts
+ in fmap (\x -> x :!: initialPPos "facts" :!: ContRoot) facts'
settingvars = fmap (\x -> PString x :!: initialPPos "settings" :!:
ContClass "settings") settings
baseVars = HM.fromList [ ("::", ScopeInformation (factvars `mappend`
callervars) mempty mempty (CurContainer ContRoot mempty) mempty S.Nothing)
, ("settings", ScopeInformation settingvars
mempty mempty (CurContainer (ContClass "settings") mempty) mempty S.Nothing)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Interpreter.hs
new/language-puppet-1.3.8.1/Puppet/Interpreter.hs
--- old/language-puppet-1.3.7/Puppet/Interpreter.hs 2017-03-14
18:12:16.000000000 +0100
+++ new/language-puppet-1.3.8.1/Puppet/Interpreter.hs 2017-06-22
16:21:07.000000000 +0200
@@ -210,7 +210,7 @@
evaluateNode (NodeDecl _ sx inheritnode p) = do
curPos .= p
pushScope ContRoot
- unless (S.isNothing inheritnode) $ throwPosError "Node inheritance
is not handled yet, and will probably never be"
+ unless (S.isNothing inheritnode) $ throwPosError "Node inheritance
is not handled. It is deprecated since puppet v4"
mapM evaluateStatement sx >>= finalize . concat
noderes <- evaluateNode nd >>= finalStep . (++ (mainstage : topres))
@@ -557,11 +557,11 @@
--
-- It is able to fill unset parameters with values from Hiera (for classes
-- only) or default values.
-loadParameters :: Foldable f => Container PValue -> f (Pair Text (S.Maybe
Expression)) -> PPosition -> S.Maybe T.Text -> InterpreterMonad ()
+loadParameters :: Foldable f => Container PValue -> f (Pair (Pair Text
(S.Maybe DataType)) (S.Maybe Expression)) -> PPosition -> S.Maybe T.Text ->
InterpreterMonad ()
loadParameters params classParams defaultPos wHiera = do
p <- use curPos
curPos .= defaultPos
- let classParamSet = HS.fromList (classParams ^.. folded . _1)
+ let classParamSet = HS.fromList (classParams ^.. folded . _1 . _1)
spuriousParams = ikeys params `HS.difference` classParamSet
mclassdesc = S.maybe mempty ((\x -> mempty <+> "when
including class" <+> x) . ttext) wHiera
@@ -588,10 +588,12 @@
-- try to set a value to all parameters
-- The order of evaluation is defined / hiera / default
- unsetParams <- fmap concat $ for (toList classParams) $ \(k :!: defValue)
-> do
+ unsetParams <- fmap concat $ for (toList classParams) $ \(k :!: mtype :!:
defValue) -> do
ev <- runExceptT (checkDef k <|> checkHiera k <|> checkDefault
defValue)
case ev of
- Right v -> loadVariable k v >> return []
+ Right v -> do
+ forM_ mtype $ \dt -> unless (datatypeMatch dt v) (throwPosError
("Expected type" <+> pretty dt <+> "for parameter" <+> pretty k <+> "but its
value was:" <+> pretty v))
+ loadVariable k v >> return []
Left (Max True) -> loadVariable k PUndef >> return []
Left (Max False) -> return [k]
curPos .= p
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Lens.hs
new/language-puppet-1.3.8.1/Puppet/Lens.hs
--- old/language-puppet-1.3.7/Puppet/Lens.hs 2015-12-10 19:50:05.000000000
+0100
+++ new/language-puppet-1.3.8.1/Puppet/Lens.hs 2017-06-22 10:16:04.000000000
+0200
@@ -3,7 +3,7 @@
( -- * Pure resolution prisms
_PResolveExpression
, _PResolveValue
- -- * Prisms for PValues
+ -- * Prisms for PValues (reexport from "Puppet.Interpreter.Types")
, _PHash
, _PBoolean
, _PString
@@ -67,8 +67,6 @@
import Data.Tuple.Strict hiding (uncurry)
import Control.Exception (SomeException, toException, fromException)
--- Prisms
-makePrisms ''PValue
--makePrisms ''Statement
makePrisms ''Expression
@@ -152,6 +150,7 @@
toU (PResourceReference t n) = UResourceReference t (Terminal (UString
n))
toU (PArray r) = UArray (fmap (Terminal . toU) r)
toU (PHash h) = UHash (V.fromList $ map (\(k,v) -> (Terminal (UString
k) :!: Terminal (toU v))) $ HM.toList h)
+ toU (PType _) = error "TODO, _PResolveValue PType undefined"
-- | Extracts the statements from 'ClassDeclaration', 'DefineDeclaration',
-- 'Node' and the spurious statements of 'TopContainer'.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Parser/PrettyPrinter.hs
new/language-puppet-1.3.8.1/Puppet/Parser/PrettyPrinter.hs
--- old/language-puppet-1.3.7/Puppet/Parser/PrettyPrinter.hs 2015-12-10
19:50:05.000000000 +0100
+++ new/language-puppet-1.3.8.1/Puppet/Parser/PrettyPrinter.hs 2017-06-22
13:23:58.000000000 +0200
@@ -34,6 +34,32 @@
escapeChar x = T.singleton x
{-# INLINE stringEscape #-}
+instance Pretty DataType where
+ pretty t = case t of
+ DTType -> "Type"
+ DTString ma mb -> bounded "String" ma mb
+ DTInteger ma mb -> bounded "Integer" ma mb
+ DTFloat ma mb -> bounded "Float" ma mb
+ DTBoolean -> "Boolean"
+ DTArray dt mi mmx -> "Array" <> list (pretty dt : pretty mi :
maybe [] (pure . pretty) mmx)
+ DTHash kt dt mi mmx -> "Hash" <> list (pretty kt : pretty dt :
pretty mi : maybe [] (pure . pretty) mmx)
+ DTUndef -> "Undef"
+ DTScalar -> "Scalar"
+ DTData -> "Data"
+ DTOptional o -> "Optional" <> brackets (pretty o)
+ NotUndef -> "NotUndef"
+ DTVariant vs -> "Variant" <> list (foldMap (pure .
pretty) vs)
+ DTPattern vs -> "Pattern" <> list (foldMap (pure .
pretty) vs)
+ DTEnum tx -> "Enum" <> list (foldMap (pure . text .
T.unpack) tx)
+ DTAny -> "Any"
+ DTCollection -> "Collection"
+ where
+ bounded :: (Pretty a, Pretty b) => Doc -> Maybe a -> Maybe b -> Doc
+ bounded s ma mb = s <> case (ma, mb) of
+ (Just a, Nothing) -> list [pretty a]
+ (Just a, Just b) -> list [pretty a, pretty b]
+ _ -> mempty
+
instance Pretty Expression where
pretty (Equal a b) = parens (pretty a <+> text "==" <+> pretty
b)
pretty (Different a b) = parens (pretty a <+> text "!=" <+> pretty
b)
@@ -66,6 +92,7 @@
pretty LambReduce = bold $ red $ text "reduce"
pretty LambFilter = bold $ red $ text "filter"
pretty LambSlice = bold $ red $ text "slice"
+ pretty LambLookup = bold $ red $ text "lookup"
instance Pretty LambdaParameters where
pretty b = magenta (char '|') <+> vars <+> magenta (char '|')
@@ -96,11 +123,14 @@
pretty (UResourceReference t n) = capitalize t <> brackets (pretty n)
pretty (UArray v) = list (map pretty (V.toList v))
pretty (UHash g) = hashComma g
- pretty (URegexp (CompRegex r _)) = char '/' <> text (T.unpack r) <> char
'/'
+ pretty (URegexp r) = pretty r
pretty (UVariableReference v) = dullblue (char '$' <> text (T.unpack v))
pretty (UFunctionCall f args) = showFunc f args
pretty (UHOLambdaCall c) = pretty c
+instance Pretty CompRegex where
+ pretty (CompRegex r _) = char '/' <> text (T.unpack r) <> char '/'
+
instance Pretty HOLambdaCall where
pretty (HOLambdaCall hf me bp stts mee) = pretty hf <> mme <+> pretty bp
<+> nest 2 (char '{' <$> ppStatements stts <> mmee) <$> char '}'
where
@@ -112,6 +142,7 @@
S.Nothing -> mempty
instance Pretty SelectorCase where
pretty SelectorDefault = dullmagenta (text "default")
+ pretty (SelectorType t) = pretty t
pretty (SelectorValue v) = pretty v
instance Pretty LinkType where
@@ -138,15 +169,15 @@
maxlen = maximum (fmap (\(AttributeDecl k _ _) -> T.length k) vx)
prettyDecl (AttributeDecl k op v) = dullblue (fill maxlen (ttext k))
<+> pretty op <+> pretty v
-showArgs :: V.Vector (Pair T.Text (S.Maybe Expression)) -> Doc
+showArgs :: V.Vector (Pair (Pair T.Text (S.Maybe DataType)) (S.Maybe
Expression)) -> Doc
showArgs vec = tupled (map ra lst)
where
lst = V.toList vec
- maxlen = maximum (map (T.length . S.fst) lst)
- ra (argname :!: rval) = dullblue (char '$' <> fill maxlen (text
(T.unpack argname)))
- <> case rval of
- S.Nothing -> empty
- S.Just v -> empty <+> char '=' <+>
pretty v
+ maxlen = maximum (map (T.length . S.fst . S.fst) lst)
+ ra (argname :!: mtype :!: rval)
+ = dullblue (char '$' <> foldMap (\t -> pretty t <+> empty) mtype
+ <> fill maxlen (text (T.unpack argname)))
+ <> foldMap (\v -> empty <+> char '=' <+> pretty
v) rval
showFunc :: T.Text -> V.Vector Expression -> Doc
showFunc funcname args = bold (red (text (T.unpack funcname))) <> parensList
args
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Parser/Types.hs
new/language-puppet-1.3.8.1/Puppet/Parser/Types.hs
--- old/language-puppet-1.3.7/Puppet/Parser/Types.hs 2017-01-12
07:15:51.000000000 +0100
+++ new/language-puppet-1.3.8.1/Puppet/Parser/Types.hs 2017-07-21
11:58:54.000000000 +0200
@@ -30,6 +30,8 @@
Virtuality(..),
NodeDesc(..),
LinkType(..),
+ -- ** Datatypes
+ DataType(..),
-- ** Search Expressions
SearchExpression(..),
-- ** Statements
@@ -52,6 +54,7 @@
import Control.Lens
import Data.Aeson
+import Data.Aeson.TH (deriveToJSON)
import Data.Char (toUpper)
import Data.Hashable
import qualified Data.Maybe.Strict as S
@@ -61,6 +64,7 @@
import qualified Data.Text as T
import Data.Tuple.Strict
import qualified Data.Vector as V
+import Data.List.NonEmpty (NonEmpty)
import GHC.Exts
import GHC.Generics
@@ -110,6 +114,7 @@
| LambReduce
| LambFilter
| LambSlice
+ | LambLookup
deriving (Eq, Show)
-- | Lambda block parameters:
@@ -147,6 +152,10 @@
show (CompRegex t _) = show t
instance Eq CompRegex where
(CompRegex a _) == (CompRegex b _) = a == b
+instance FromJSON CompRegex where
+ parseJSON = fail "Can't deserialize a regular expression"
+instance ToJSON CompRegex where
+ toJSON (CompRegex t _) = toJSON t
-- | An unresolved value, typically the parser's output.
data UnresolvedValue
@@ -176,6 +185,7 @@
data SelectorCase
= SelectorValue !UnresolvedValue
+ | SelectorType !DataType
| SelectorDefault
deriving (Eq, Show)
@@ -207,6 +217,29 @@
| Terminal !UnresolvedValue -- ^ Terminal object contains no expression
deriving (Eq, Show)
+data DataType
+ = DTType
+ | DTString (Maybe Int) (Maybe Int)
+ | DTInteger (Maybe Int) (Maybe Int)
+ | DTFloat (Maybe Double) (Maybe Double)
+ | DTBoolean
+ | DTArray DataType Int (Maybe Int)
+ | DTHash DataType DataType Int (Maybe Int)
+ | DTUndef
+ | DTScalar
+ | DTData
+ | DTOptional DataType
+ | NotUndef
+ | DTVariant (NonEmpty DataType)
+ | DTPattern (NonEmpty CompRegex)
+ | DTEnum (NonEmpty Text)
+ | DTAny
+ | DTCollection
+ -- Tuple (NonEmpty DataType) Integer Integer
+ -- DTDefault
+ -- Struct TODO
+ deriving (Eq, Show)
+
instance IsList Expression where
type Item Expression = Expression
fromList = Terminal . fromList
@@ -299,8 +332,8 @@
-- (interpreted as "if first cond is true, choose first statements, else take
the next pair, check the condition ...")
data ConditionalDecl = ConditionalDecl !(V.Vector (Pair Expression (V.Vector
Statement))) !PPosition deriving (Eq, Show)
-data ClassDecl = ClassDecl !Text !(V.Vector (Pair Text (S.Maybe Expression)))
!(S.Maybe Text) !(V.Vector Statement) !PPosition deriving (Eq, Show)
-data DefineDecl = DefineDecl !Text !(V.Vector (Pair Text (S.Maybe
Expression))) !(V.Vector Statement) !PPosition deriving (Eq, Show)
+data ClassDecl = ClassDecl !Text !(V.Vector (Pair (Pair Text (S.Maybe
DataType)) (S.Maybe Expression))) !(S.Maybe Text) !(V.Vector Statement)
!PPosition deriving (Eq, Show)
+data DefineDecl = DefineDecl !Text !(V.Vector (Pair (Pair Text (S.Maybe
DataType)) (S.Maybe Expression))) !(V.Vector Statement) !PPosition deriving
(Eq, Show)
-- | A node is a collection of statements + maybe an inherit node
data NodeDecl = NodeDecl !NodeDesc !(V.Vector Statement) !(S.Maybe NodeDesc)
!PPosition deriving (Eq, Show)
@@ -338,3 +371,5 @@
deriving (Eq, Show)
makeClassy ''HOLambdaCall
+$(deriveToJSON defaultOptions ''DataType)
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Parser.hs
new/language-puppet-1.3.8.1/Puppet/Parser.hs
--- old/language-puppet-1.3.7/Puppet/Parser.hs 2017-01-12 07:15:51.000000000
+0100
+++ new/language-puppet-1.3.8.1/Puppet/Parser.hs 2017-06-22
13:21:05.000000000 +0200
@@ -6,6 +6,7 @@
-- * Parsers
, puppetParser
, expression
+ , datatype
) where
import Control.Applicative
@@ -13,7 +14,10 @@
import Control.Monad
import Data.Char
import qualified Data.Foldable as F
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NE
import qualified Data.Maybe.Strict as S
+import Data.Maybe (fromMaybe)
import Data.Scientific
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
@@ -86,16 +90,19 @@
symbolic '?'
return $ maybe trm ($ trm) lookups
let cas = do
- c <- (SelectorDefault <$ symbol "default") -- default case
- <|> fmap SelectorValue (fmap UVariableReference
variableReference
- <|> fmap UBoolean puppetBool
- <|> (UUndef <$ symbol "undef")
- <|> literalValue
- <|> fmap UInterpolable
interpolableString
- <|> (URegexp <$> termRegexp))
- void $ symbol "=>"
- e <- expression
- return (c :!: e)
+ c <- (SelectorDefault <$ symbol "default") -- default case
+ <|> fmap SelectorType (try datatype)
+ <|> fmap SelectorValue
+ ( fmap UVariableReference variableReference
+ <|> fmap UBoolean puppetBool
+ <|> (UUndef <$ symbol "undef")
+ <|> literalValue
+ <|> fmap UInterpolable interpolableString
+ <|> (URegexp <$> termRegexp)
+ )
+ void $ symbol "=>"
+ e <- expression
+ return (c :!: e)
cases <- braces (sepComma1 cas)
return (ConditionalValue selectedExpression (V.fromList cases))
@@ -198,17 +205,12 @@
return v
rvariable = Terminal . UVariableReference <$> rvariableName
simpleIndexing = Lookup <$> rvariable <*> between (symbolic '[')
(symbolic ']') expression
- interpolableVariableReference = try $ do
+ interpolableVariableReference = do
void (char '$')
- lookAhead anyChar >>= \c -> case c of
- '{' -> between (symbolic '{') (char '}') ( try
simpleIndexing
- <|> rvariable
- )
- -- This is not as robust as the "qualif"
- -- implementation, but considerably shorter.
- --
- -- This needs refactoring.
- _ -> rvariable
+ let fenced = try (simpleIndexing <* char '}')
+ <|> try (rvariable <* char '}')
+ <|> (expression <* char '}')
+ (symbolic '{' *> fenced) <|> try rvariable <|> pure (Terminal
(UString (T.singleton '$')))
regexp :: Parser T.Text
regexp = do
@@ -377,15 +379,17 @@
pe <- getPosition
return (DefineDecl name params st (p :!: pe))
-puppetClassParameters :: Parser (V.Vector (Pair T.Text (S.Maybe Expression)))
+puppetClassParameters :: Parser (V.Vector (Pair (Pair T.Text (S.Maybe
DataType)) (S.Maybe Expression)))
puppetClassParameters = V.fromList <$> parens (sepComma var)
where
toStrictMaybe (Just x) = S.Just x
toStrictMaybe Nothing = S.Nothing
- var :: Parser (Pair T.Text (S.Maybe Expression))
- var = (:!:)
- <$> variableReference
- <*> (toStrictMaybe <$> optional (symbolic '=' *> expression))
+ var :: Parser (Pair (Pair T.Text (S.Maybe DataType)) (S.Maybe
Expression))
+ var = do
+ tp <- toStrictMaybe <$> optional datatype
+ n <- variableReference
+ df <- toStrictMaybe <$> optional (symbolic '=' *> expression)
+ return (n :!: tp :!: df)
puppetIfStyleCondition :: Parser (Pair Expression (V.Vector Statement))
puppetIfStyleCondition = (:!:) <$> expression <*> braces statementList
@@ -631,6 +635,67 @@
<|> (pure . MainFunctionDeclaration <$> mainFuncDecl)
<?> "Statement"
+datatype :: Parser DataType
+datatype = dtString
+ <|> dtInteger
+ <|> dtFloat
+ <|> dtNumeric
+ <|> (DTBoolean <$ reserved "Boolean")
+ <|> (DTScalar <$ reserved "Scalar")
+ <|> (DTData <$ reserved "Data")
+ <|> (DTAny <$ reserved "Any")
+ <|> (DTCollection <$ reserved "Collection")
+ <|> dtArray
+ <|> dtHash
+ <|> (DTUndef <$ reserved "Undef")
+ <|> (reserved "Optional" *> (DTOptional <$> brackets datatype))
+ <|> (NotUndef <$ reserved "NotUndef")
+ <|> (reserved "Variant" *> (DTVariant . NE.fromList <$> brackets
(datatype `sepBy1` symbolic ',')))
+ <|> (reserved "Pattern" *> (DTPattern . NE.fromList <$> brackets
(termRegexp `sepBy1` symbolic ',')))
+ <|> (reserved "Enum" *> (DTEnum . NE.fromList <$> brackets
((stringLiteral' <|> bareword) `sepBy1` symbolic ',')))
+ <?> "DataType"
+ where
+ integer = integerOrDouble >>= either (return . fromIntegral) (const (fail
"Integer value expected"))
+ float = either fromIntegral id <$> integerOrDouble
+ dtArgs str def parseArgs = do
+ void $ reserved str
+ fromMaybe def <$> optional (brackets parseArgs)
+ dtbounded s constructor parser = dtArgs s (constructor Nothing Nothing) $
do
+ lst <- parser `sepBy` symbolic ','
+ case lst of
+ [minlen] -> return $ constructor (Just minlen) Nothing
+ [minlen,maxlen] -> return $ constructor (Just minlen) (Just maxlen)
+ _ -> fail ("Too many arguments to datatype " ++ s)
+ dtString = dtbounded "String" DTString integer
+ dtInteger = dtbounded "Integer" DTInteger integer
+ dtFloat = dtbounded "Float" DTFloat float
+ dtNumeric = dtbounded "Numeric" (\ma mb -> DTVariant (DTFloat ma mb :|
[DTInteger (truncate <$> ma) (truncate <$> mb)])) float
+ dtArray = do
+ reserved "Array"
+ ml <- optional $ brackets $ do
+ tp <- datatype
+ rst <- optional (symbolic ',' *> integer `sepBy1` symbolic ',')
+ return (tp, rst)
+ case ml of
+ Nothing -> return (DTArray DTData 0 Nothing)
+ Just (t, Nothing) -> return (DTArray t 0 Nothing)
+ Just (t, Just [mi]) -> return (DTArray t mi Nothing)
+ Just (t, Just [mi, mx]) -> return (DTArray t mi (Just mx))
+ Just (_, Just _) -> fail "Too many arguments to datatype Array"
+ dtHash = do
+ reserved "Hash"
+ ml <- optional $ brackets $ do
+ tk <- datatype
+ symbolic ','
+ tv <- datatype
+ rst <- optional (symbolic ',' *> integer `sepBy1` symbolic ',')
+ return (tk, tv, rst)
+ case ml of
+ Nothing -> return (DTHash DTScalar DTData 0 Nothing)
+ Just (tk, tv, Nothing) -> return (DTHash tk tv 0 Nothing)
+ Just (tk, tv, Just [mi]) -> return (DTHash tk tv mi Nothing)
+ Just (tk, tv, Just [mi, mx]) -> return (DTHash tk tv mi (Just mx))
+ Just (_, _, Just _) -> fail "Too many arguments to datatype Hash"
statementList :: Parser (V.Vector Statement)
statementList = (V.fromList . concat) <$> many statement
@@ -640,17 +705,18 @@
let toStrict (Just x) = S.Just x
toStrict Nothing = S.Nothing
HOLambdaCall <$> lambFunc
- <*> fmap (toStrict . join) (optional (parens (optional
expression)))
- <*> lambParams
- <*> (symbolic '{' *> fmap (V.fromList . concat) (many (try
statement)))
- <*> fmap toStrict (optional expression) <* symbolic '}'
+ <*> fmap (toStrict . join) (optional (parens (optional
expression)))
+ <*> lambParams
+ <*> (symbolic '{' *> fmap (V.fromList . concat) (many (try
statement)))
+ <*> fmap toStrict (optional expression) <* symbolic '}'
where
lambFunc :: Parser LambdaFunc
lambFunc = (reserved "each" *> pure LambEach)
- <|> (reserved "map" *> pure LambMap )
- <|> (reserved "reduce" *> pure LambReduce)
- <|> (reserved "filter" *> pure LambFilter)
- <|> (reserved "slice" *> pure LambSlice)
+ <|> (reserved "map" *> pure LambMap )
+ <|> (reserved "reduce" *> pure LambReduce)
+ <|> (reserved "filter" *> pure LambFilter)
+ <|> (reserved "slice" *> pure LambSlice)
+ <|> (reserved "lookup" *> pure LambLookup)
lambParams :: Parser LambdaParameters
lambParams = between (symbolic '|') (symbolic '|') hp
where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/Puppet/Stdlib.hs
new/language-puppet-1.3.8.1/Puppet/Stdlib.hs
--- old/language-puppet-1.3.7/Puppet/Stdlib.hs 2017-03-14 18:12:16.000000000
+0100
+++ new/language-puppet-1.3.8.1/Puppet/Stdlib.hs 2017-06-22
10:17:30.000000000 +0200
@@ -23,7 +23,6 @@
import Puppet.Interpreter.Resolve
import Puppet.Interpreter.Types
import Puppet.Interpreter.Utils
-import Puppet.Lens
import Puppet.PP
-- | Contains the implementation of the StdLib functions.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/PuppetDB/TestDB.hs
new/language-puppet-1.3.8.1/PuppetDB/TestDB.hs
--- old/language-puppet-1.3.7/PuppetDB/TestDB.hs 2017-01-12
07:15:51.000000000 +0100
+++ new/language-puppet-1.3.8.1/PuppetDB/TestDB.hs 2017-06-22
10:17:44.000000000 +0200
@@ -28,7 +28,6 @@
import Text.Megaparsec.Pos
import Puppet.Interpreter.Types
-import Puppet.Lens
import Puppet.Parser.Types
import Puppet.PP
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/README.adoc
new/language-puppet-1.3.8.1/README.adoc
--- old/language-puppet-1.3.7/README.adoc 2017-03-14 18:12:16.000000000
+0100
+++ new/language-puppet-1.3.8.1/README.adoc 2017-06-19 12:43:44.000000000
+0200
@@ -17,11 +17,10 @@
git clone https://github.com/bartavelle/language-puppet.git
cd language-puppet
# Add ~/.local/bin to $PATH
+ln -s stack-8.0.yaml stack.yaml
stack install
```
-https://hub.docker.com/r/pierrer/language-puppet/[A docker image] is available.
-
== Puppetresources
The `puppetresources` command is a command line utility that let you
interactively compute catalogs on your local computer.
@@ -173,8 +172,12 @@
== Unsupported Puppet idioms or features
+OS::
+ * `OS X` is currently not supported
(https://github.com/bartavelle/language-puppet/issues/197[issue #197])
+
puppet functions::
* the `require` function is not supported (see
https://github.com/bartavelle/language-puppet/issues/17[issue #17])
- * the deprecated `import` function is not supported (see
https://github.com/bartavelle/language-puppet/issues/82[issue #82])
+ * the deprecated `import` function is not supported
+ * the deprecated node inheritance feature is not supported
custom ruby functions::
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/language-puppet.cabal
new/language-puppet-1.3.8.1/language-puppet.cabal
--- old/language-puppet-1.3.7/language-puppet.cabal 2017-03-14
18:12:16.000000000 +0100
+++ new/language-puppet-1.3.8.1/language-puppet.cabal 2017-07-21
12:03:54.000000000 +0200
@@ -2,7 +2,7 @@
-- documentation, see http://haskell.org/cabal/users-guide/
name: language-puppet
-version: 1.3.7
+version: 1.3.8.1
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.10.3, GHC == 8.0.1
+Tested-With: GHC == 7.10.3, GHC == 8.0.2
extra-source-files:
CHANGELOG.markdown
@@ -175,7 +175,7 @@
type: exitcode-stdio-1.0
ghc-options: -Wall -rtsopts -threaded
extensions: OverloadedStrings
- build-depends:
language-puppet,base,strict-base-types,lens,text,hspec,unordered-containers,megaparsec,vector,scientific,mtl
+ build-depends:
language-puppet,base,strict-base-types,lens,text,hspec,unordered-containers,megaparsec,vector,scientific,mtl,hspec-megaparsec
other-modules: Function.ShellquoteSpec
Function.SprintfSpec
Function.SizeSpec
@@ -187,6 +187,7 @@
InterpreterSpec
Interpreter.CollectorSpec
Interpreter.IfSpec
+ DT.Parser
Helpers
main-is: Spec.hs
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/progs/PuppetResources.hs
new/language-puppet-1.3.8.1/progs/PuppetResources.hs
--- old/language-puppet-1.3.7/progs/PuppetResources.hs 2017-01-12
07:15:51.000000000 +0100
+++ new/language-puppet-1.3.8.1/progs/PuppetResources.hs 2017-06-22
12:56:45.000000000 +0200
@@ -371,7 +371,7 @@
-- | Parse mode
run Options {_optParse = Just fp, ..} = parseFile fp >>= \case
- Left rr -> error ("parse error:" ++ show rr)
+ Left rr -> error (P.parseErrorPretty rr)
Right s -> if _optLoglevel == LOG.DEBUG
then mapM_ print s
else putDoc $ ppStatements s
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/tests/DT/Parser.hs
new/language-puppet-1.3.8.1/tests/DT/Parser.hs
--- old/language-puppet-1.3.7/tests/DT/Parser.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/language-puppet-1.3.8.1/tests/DT/Parser.hs 2017-07-21
11:50:10.000000000 +0200
@@ -0,0 +1,19 @@
+module DT.Parser (spec) where
+
+import qualified Data.Text as T
+import Puppet.Parser
+import Puppet.Parser.Types
+import Test.Hspec
+import Test.Hspec.Megaparsec
+import Text.Megaparsec (parse)
+
+spec :: Spec
+spec = do
+ let prs s r = it s $ parse datatype "?" (T.pack s) `shouldParse` r
+ fl s = it s $ shouldFailOn (parse datatype "?") (T.pack s)
+ describe "String" $ do
+ "String" `prs` DTString Nothing Nothing
+ fl "String[]"
+ fl "String[4,5,6]"
+ "String[5]" `prs` DTString (Just 5) Nothing
+ "String[5,8]" `prs` DTString (Just 5) (Just 8)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/tests/Spec.hs
new/language-puppet-1.3.8.1/tests/Spec.hs
--- old/language-puppet-1.3.7/tests/Spec.hs 2017-03-14 18:12:16.000000000
+0100
+++ new/language-puppet-1.3.8.1/tests/Spec.hs 2017-06-19 13:28:05.000000000
+0200
@@ -11,12 +11,15 @@
import qualified Function.DeleteAtSpec
import qualified Interpreter.IfSpec
import qualified Function.SprintfSpec
+import qualified DT.Parser
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
+ describe "Data types" $ do
+ describe "Parser" DT.Parser.spec
describe "Interpreter" $ do
describe "Collector" InterpreterSpec.collectorSpec
describe "Class include" InterpreterSpec.classIncludeSpec
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/tests/evals.hs
new/language-puppet-1.3.8.1/tests/evals.hs
--- old/language-puppet-1.3.7/tests/evals.hs 2015-10-29 20:18:03.000000000
+0100
+++ new/language-puppet-1.3.8.1/tests/evals.hs 2017-06-14 10:52:51.000000000
+0200
@@ -21,6 +21,8 @@
, "[1,2,3] << 10 == [1,2,3,10]"
, "[1,2,3] << [4,5] == [1,2,3,[4,5]]"
, "4 / 2.0 == 2"
+ , "$architecture == 'amd64'"
+ , "$facts['architecture'] == 'amd64'"
, "$settings::confdir == '/etc/puppet'"
, "regsubst('127', '([0-9]+)', '<\\1>', 'G') == '<127>'"
, "regsubst(['1','2','3'], '([0-9]+)', '<\\1>', 'G') ==
['<1>','<2>','<3>']"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/language-puppet-1.3.7/tests/expr.hs
new/language-puppet-1.3.8.1/tests/expr.hs
--- old/language-puppet-1.3.7/tests/expr.hs 2016-03-14 08:12:49.000000000
+0100
+++ new/language-puppet-1.3.8.1/tests/expr.hs 2017-06-14 10:52:51.000000000
+0200
@@ -23,9 +23,12 @@
(V.fromList [SelectorValue UUndef :!: Terminal (UString "undef")
,SelectorDefault :!: Terminal (UString "default")]))
, ("$x", Terminal (UVariableReference "x"))
+ , ("x($y)", Terminal (UFunctionCall "x" (V.singleton (Terminal
(UVariableReference "y")))))
, ("\"${x}\"", Terminal (UInterpolable (V.fromList [Terminal
(UVariableReference "x")])))
, ("\"${x[3]}\"", Terminal (UInterpolable (V.fromList [Lookup (Terminal
(UVariableReference "x")) 3])))
, ("\"${x[$y]}\"", Terminal (UInterpolable (V.fromList [Lookup (Terminal
(UVariableReference "x")) (Terminal (UVariableReference "y")) ])))
+ , ("\"${x($y)}\"", Terminal (UInterpolable (V.fromList [ Terminal
(UFunctionCall "x" (V.singleton (Terminal (UVariableReference "y")))) ])))
+ , ("\"${x($y)}$'\"", Terminal (UInterpolable (V.fromList [ Terminal
(UFunctionCall "x" (V.singleton (Terminal (UVariableReference "y")))),Terminal
(UString "$"),Terminal (UString "'")])))
]
main :: IO ()
