language-puppet 1.3.8.1 → 1.3.9
raw patch · 10 files changed
+59/−43 lines, 10 filesdep −eitherdep ~megaparsec
Dependencies removed: either
Dependency ranges changed: megaparsec
Files
- CHANGELOG.markdown +4/−0
- Puppet/Interpreter/Resolve.hs +15/−10
- Puppet/Parser.hs +21/−18
- Puppet/Parser/PrettyPrinter.hs +3/−2
- Puppet/Parser/Types.hs +8/−3
- PuppetDB/Dummy.hs +0/−1
- language-puppet.cabal +3/−4
- progs/PuppetResources.hs +2/−1
- tests/Helpers.hs +0/−1
- tests/lexer.hs +3/−3
CHANGELOG.markdown view
@@ -1,3 +1,7 @@+# v1.3.9 (2017/07/30)++* Moved to megaparsec 6+ # v1.3.8.1 (2017/07/21) * Fix haddocks error (#208)
Puppet/Interpreter/Resolve.hs view
@@ -632,17 +632,22 @@ S.Just x -> return x S.Nothing -> throwPosError ("No expression to run the function on" <+> pretty hol) sourcevalue <- resolveExpression sourceexpression+ let check Nothing = const (return ())+ check (Just dtype) = mapM_ (\v -> unless (datatypeMatch dtype v) (throwPosError (pretty v <+> "isn't of type" <+> pretty dtype))) case (sourcevalue, hol ^. hoLambdaParams) of- (PArray pr, BPSingle varname) -> return (map (\x -> [(varname, x)]) (V.toList pr))- (PArray pr, BPPair idx var) -> return $ do- (i,v) <- Prelude.zip ([0..] :: [Int]) (V.toList pr)- return [(idx,PString (T.pack (show i))),(var,v)]- (PHash hh, BPSingle varname) -> return $ do- (k,v) <- HM.toList hh- return [(varname, PArray (V.fromList [PString k,v]))]- (PHash hh, BPPair idx var) -> return $ do- (k,v) <- HM.toList hh- return [(idx,PString k),(var,v)]+ (PArray pr, BPSingle (LParam mvtype varname)) -> do+ check mvtype pr+ return (map (\x -> [(varname, x)]) (V.toList pr))+ (PArray pr, BPPair (LParam _ idx) (LParam mvtype var)) -> do+ check mvtype pr+ return [ [(idx,PString (T.pack (show i))),(var,v)] | (i,v) <- Prelude.zip ([0..] :: [Int]) (V.toList pr) ]+ (PHash hh, BPSingle (LParam mvtype varname)) -> do+ check mvtype hh+ return [ [(varname, PArray (V.fromList [PString k,v]))] | (k,v) <- HM.toList hh]+ (PHash hh, BPPair (LParam midxtype idx) (LParam mvtype var)) -> do+ check mvtype hh+ check midxtype (PString <$> HM.keys hh)+ return [ [(idx,PString k),(var,v)] | (k,v) <- HM.toList hh] (invalid, _) -> throwPosError ("Can't iterate on this data type:" <+> pretty invalid) -- | Sets the proper variables, and returns the scope variables the way
Puppet/Parser.hs view
@@ -23,17 +23,20 @@ import qualified Data.Text.Encoding as T import Data.Tuple.Strict hiding (fst,zip) import qualified Data.Vector as V+import Data.Void (Void) import Text.Megaparsec hiding (token)+import Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L import Text.Megaparsec.Expr-import qualified Text.Megaparsec.Lexer as L-import Text.Megaparsec.Text import Text.Regex.PCRE.ByteString.Utils import Puppet.Parser.Types import Puppet.Utils +type Parser = Parsec Void T.Text+ -- | Run a puppet parser against some 'T.Text' input.-runPParser :: String -> T.Text -> Either (ParseError Char Dec) (V.Vector Statement)+runPParser :: String -> T.Text -> Either (ParseError Char Void) (V.Vector Statement) runPParser = parse puppetParser someSpace :: Parser ()@@ -43,17 +46,15 @@ token = L.lexeme someSpace integerOrDouble :: Parser (Either Integer Double)-integerOrDouble = fmap Right (try (L.signed someSpace L.float)) <|> fmap Left (hex <|> dec)+integerOrDouble = fmap Left hex <|> (either Right Left . floatingOrInteger <$> L.scientific) where- dec = L.signed someSpace L.integer- hex = try (string "0x") *> L.hexadecimal-+ hex = string "0x" *> L.hexadecimal -symbol :: String -> Parser ()+symbol :: T.Text -> Parser () symbol = void . try . L.symbol someSpace symbolic :: Char -> Parser ()-symbolic = symbol . pure+symbolic = symbol . T.singleton braces :: Parser a -> Parser a braces = between (symbol "{") (symbol "}")@@ -128,10 +129,10 @@ nxt <- token $ many nxtl return $ T.pack $ f : nxt -operator :: String -> Parser ()+operator :: T.Text -> Parser () operator = void . try . symbol -reserved :: String -> Parser ()+reserved :: T.Text -> Parser () reserved s = try $ do void (string s) notFollowedBy (satisfy identifierPart)@@ -147,8 +148,8 @@ qualif :: Parser T.Text -> Parser T.Text qualif p = token $ do- header <- T.pack <$> option "" (try (string "::"))- ( header <> ) . T.intercalate "::" <$> p `sepBy1` try (string "::")+ header <- option "" (string "::")+ ( header <> ) . T.intercalate "::" <$> p `sepBy1` string "::" qualif1 :: Parser T.Text -> Parser T.Text qualif1 p = try $ do@@ -200,7 +201,7 @@ -- this is specialized because we can't be "tokenized" here variableAccept x = isAsciiLower x || isAsciiUpper x || isDigit x || x == '_' rvariableName = do- v <- T.pack . concat <$> some (string "::" <|> some (satisfy variableAccept))+ v <- T.concat <$> some (string "::" <|> fmap T.pack (some (satisfy variableAccept))) when (v == "string") (fail "The special variable $string must not be used") return v rvariable = Terminal . UVariableReference <$> rvariableName@@ -655,17 +656,17 @@ <|> (reserved "Enum" *> (DTEnum . NE.fromList <$> brackets ((stringLiteral' <|> bareword) `sepBy1` symbolic ','))) <?> "DataType" where- integer = integerOrDouble >>= either (return . fromIntegral) (const (fail "Integer value expected"))+ integer = integerOrDouble >>= either (return . fromIntegral) (\d -> fail ("Integer value expected, instead of " ++ show d)) 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 ','+ lst <- parser `sepBy1` 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)+ _ -> fail ("Too many arguments to datatype " ++ T.unpack s) dtString = dtbounded "String" DTString integer dtInteger = dtbounded "Integer" DTInteger integer dtFloat = dtbounded "Float" DTFloat float@@ -721,8 +722,10 @@ lambParams = between (symbolic '|') (symbolic '|') hp where acceptablePart = T.pack <$> identifier+ lambdaParameter :: Parser LambdaParameter+ lambdaParameter = LParam <$> optional datatype <*> (char '$' *> acceptablePart) hp = do- vars <- (char '$' *> acceptablePart) `sepBy1` comma+ vars <- lambdaParameter `sepBy1` comma case vars of [a] -> return (BPSingle a) [a,b] -> return (BPPair a b)
Puppet/Parser/PrettyPrinter.hs view
@@ -97,9 +97,10 @@ instance Pretty LambdaParameters where pretty b = magenta (char '|') <+> vars <+> magenta (char '|') where+ pmspace = foldMap ((<> " ") . pretty) vars = case b of- BPSingle v -> pretty (UVariableReference v)- BPPair v1 v2 -> pretty (UVariableReference v1) <> comma <+> pretty (UVariableReference v2)+ BPSingle (LParam mt v) -> pmspace mt <> pretty (UVariableReference v)+ BPPair (LParam mt1 v1) (LParam mt2 v2) -> pmspace mt1 <> pretty (UVariableReference v1) <> comma <+> pmspace mt2 <> pretty (UVariableReference v2) instance Pretty SearchExpression where pretty (EqualitySearch t e) = text (T.unpack t) <+> text "==" <+> pretty e
Puppet/Parser/Types.hs view
@@ -24,6 +24,7 @@ HOLambdaCall(..), ChainableRes(..), HasHOLambdaCall(..),+ LambdaParameter(..), LambdaParameters(..), CompRegex(..), CollectorType(..),@@ -104,7 +105,7 @@ -- | Generates a 'PPosition' based on a filename and line number. toPPos :: Text -> Int -> PPosition toPPos fl ln =- let p = (initialPos (T.unpack fl)) { sourceLine = unsafePos $ fromIntegral (max 1 ln) }+ let p = (initialPos (T.unpack fl)) { sourceLine = mkPos $ fromIntegral (max 1 ln) } in (p :!: p) -- | High Order "lambdas"@@ -121,8 +122,12 @@ -- Currently only two types of block parameters are supported: -- single values and pairs. data LambdaParameters- = BPSingle !Text -- ^ @|k|@- | BPPair !Text !Text -- ^ @|k,v|@+ = BPSingle !LambdaParameter -- ^ @|k|@+ | BPPair !LambdaParameter !LambdaParameter -- ^ @|k,v|@+ deriving (Eq, Show)++data LambdaParameter+ = LParam !(Maybe DataType) !Text deriving (Eq, Show) -- The description of the /higher level lambda/ call.
PuppetDB/Dummy.hs view
@@ -3,7 +3,6 @@ module PuppetDB.Dummy where import Puppet.Interpreter.Types-import Control.Monad.Except dummyPuppetDB :: Monad m => PuppetDBAPI m dummyPuppetDB = PuppetDBAPI
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 1.3.8.1+version: 1.3.9 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.2+Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 extra-source-files: CHANGELOG.markdown@@ -93,7 +93,6 @@ , containers == 0.5.* , cryptonite >= 0.6 , directory >= 1.2 && < 1.4- , either >= 4.3 && < 4.5 , exceptions >= 0.8 && < 0.9 , filecache >= 0.2.9 && < 0.3 , formatting@@ -105,7 +104,7 @@ , hspec , lens >= 4.12 && < 5 , lens-aeson >= 1.0- , megaparsec >= 5 && < 6+ , megaparsec >= 6 && < 7 , memory >= 0.7 , mtl >= 2.2.1 && < 2.3 , operational >= 0.2.3 && < 0.3
progs/PuppetResources.hs view
@@ -23,6 +23,7 @@ import Data.Tuple (swap) import qualified Data.Vector as V import qualified Data.Version (showVersion)+import Data.Void (Void) import Network.HTTP.Client import Options.Applicative import qualified Paths_language_puppet@@ -47,7 +48,7 @@ import PuppetDB.Remote (pdbConnect) import PuppetDB.TestDB (loadTestDB) -type ParseError' = P.ParseError Char P.Dec+type ParseError' = P.ParseError Char Void type QueryFunc = NodeName -> IO (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) data MultNodes = MultNodes [T.Text] | AllNodes deriving Show
tests/Helpers.hs view
@@ -17,7 +17,6 @@ import Puppet.Stdlib import Control.Lens-import Control.Monad.Except import qualified Data.HashMap.Strict as HM import qualified Data.Maybe.Strict as S import Data.Text (Text, unpack)
tests/lexer.hs view
@@ -7,7 +7,7 @@ import System.Environment import Puppet.Parser.PrettyPrinter import Text.PrettyPrint.ANSI.Leijen-import Text.Megaparsec (parse, eof)+import Text.Megaparsec (parse, eof, parseErrorPretty) import System.Posix.Terminal import System.Posix.Types import System.IO@@ -26,7 +26,7 @@ testparser fp = fmap (parse (puppetParser <* eof) fp) (T.readFile fp) >>= \case Right _ -> return ("PASS", True)- Left rr -> return (show rr, False)+ Left rr -> return (parseErrorPretty rr, False) check :: String -> IO () check fname = do@@ -38,7 +38,7 @@ then renderPretty 0.2 200 else renderCompact case res of- Left rr -> print rr+ Left rr -> putStrLn (parseErrorPretty rr) Right x -> do putStrLn "" displayIO stdout (rfunc (pretty (ppStatements x)))