commit ghc-language-puppet for openSUSE:Factory
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 - psimons@suse.com + +- 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#accessi... + 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 ()
participants (1)
-
root@hilbert.suse.de