language-puppet 1.3.14 → 1.3.15
raw patch · 27 files changed
+123/−128 lines, 27 filesdep ~filecachedep ~servantdep ~servant-client
Dependency ranges changed: filecache, servant, servant-client
Files
- CHANGELOG +10/−1
- README.adoc +1/−1
- language-puppet.cabal +7/−7
- progs/PuppetResources.hs +15/−13
- ruby/hrubyerb.rb +1/−0
- src/Hiera/Server.hs +11/−10
- src/Puppet/Interpreter.hs +2/−3
- src/Puppet/Interpreter/Helpers.hs +5/−7
- src/Puppet/Interpreter/IO.hs +1/−3
- src/Puppet/Interpreter/PrettyPrinter.hs +0/−1
- src/Puppet/Interpreter/Resolve.hs +0/−2
- src/Puppet/Interpreter/Types.hs +0/−2
- src/Puppet/Language/Core.hs +10/−3
- src/Puppet/Language/Resource.hs +2/−2
- src/Puppet/Language/Value.hs +0/−1
- src/Puppet/Parser.hs +39/−45
- src/Puppet/Parser/Lens.hs +0/−1
- src/Puppet/Runner/Daemon/FileParser.hs +9/−10
- src/Puppet/Runner/Preferences.hs +0/−1
- src/PuppetDB/TestDB.hs +0/−1
- src/XPrelude.hs +4/−0
- src/XPrelude/Extra.hs +4/−8
- tests/Function/DeleteAtSpec.hs +0/−1
- tests/Function/MergeSpec.hs +0/−1
- tests/Function/SizeSpec.hs +0/−1
- tests/Helpers.hs +1/−2
- tests/InterpreterSpec.hs +1/−1
CHANGELOG view
@@ -1,4 +1,13 @@-language-puppet (1.3.14) UNRELEASED; urgency=medium+language-puppet (1.3.15) artful; urgency=medium++ * Improve parsing error messages+ * Improve source position display+ * Support OS X via filecache-0.3+ * Add ability to use the json ruby module in erbs++ -- Bartavelle <bartavelle@gmail.com> Sun, 18 Feb 2018 20:40:57 +0100++language-puppet (1.3.14) xenial; urgency=medium * Allow declaring type of variables during assignment * The `lookup` function now fails if an input strategy is unknown
README.adoc view
@@ -183,7 +183,7 @@ == Unsupported Puppet idioms or features OS::- * `OS X` is currently not supported (https://github.com/bartavelle/language-puppet/issues/197[issue #197])+ * `OS X` is supported when using the latest `filecache-0.3`. puppet functions:: * the `require` function is not supported (see https://github.com/bartavelle/language-puppet/issues/17[issue #17])
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 1.3.14+version: 1.3.15 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/@@ -88,7 +88,7 @@ , Puppet.Runner.Daemon.FileParser , Puppet.Runner.Daemon.OptionalTests , Puppet.Runner.Daemon- extensions: OverloadedStrings, BangPatterns, LambdaCase, NoImplicitPrelude+ extensions: OverloadedStrings, BangPatterns, LambdaCase, NoImplicitPrelude, FlexibleContexts, FlexibleInstances ghc-options: -Wall -funbox-strict-fields -j1 -- ghc-prof-options: -auto-all -caf-all build-depends: aeson >= 0.8@@ -102,7 +102,7 @@ , cryptonite >= 0.6 , directory >= 1.2 && < 1.4 , exceptions >= 0.8 && < 0.9- , filecache >= 0.2.9 && < 0.3+ , filecache >= 0.2.9 && < 0.4 , filepath >= 1.4 , formatting , hashable == 1.2.*@@ -124,8 +124,8 @@ , random , regex-pcre-builtin >= 0.94.4 , scientific >= 0.2 && < 0.4- , servant >= 0.9- , servant-client >= 0.9+ , servant >= 0.9 && < 0.13+ , servant-client >= 0.9 && < 0.13 , split == 0.2.* , stm == 2.4.* , strict-base-types >= 0.3@@ -161,7 +161,7 @@ hs-source-dirs: tests type: exitcode-stdio-1.0 ghc-options: -Wall -rtsopts -threaded- extensions: OverloadedStrings, NoImplicitPrelude+ extensions: OverloadedStrings, NoImplicitPrelude, FlexibleContexts Other-Modules: Helpers build-depends: language-puppet,base,hspec,temporary,strict-base-types,HUnit,lens,vector,unordered-containers,text,hslogger,neat-interpolation,protolude >=0.2,scientific,mtl main-is: hiera.hs@@ -183,7 +183,7 @@ hs-source-dirs: tests type: exitcode-stdio-1.0 ghc-options: -Wall -Wno-missing-signatures -rtsopts -threaded- extensions: OverloadedStrings, NoImplicitPrelude+ extensions: OverloadedStrings, NoImplicitPrelude, FlexibleContexts build-depends: language-puppet,base,strict-base-types,lens,text,hspec,unordered-containers,megaparsec,vector,scientific,mtl,hspec-megaparsec, protolude >= 0.2 other-modules: Function.ShellquoteSpec Function.SprintfSpec
progs/PuppetResources.hs view
@@ -23,7 +23,6 @@ import qualified System.FilePath.Glob as Glob import System.IO (hIsTerminalDevice) import qualified System.Log.Logger as Log-import qualified Text.Megaparsec as Megaparsec import qualified Text.Regex.PCRE.String as Reg import Puppet.Parser hiding (Parser)@@ -32,7 +31,6 @@ puppetDBFacts) import qualified PuppetDB -type ParseError' = Megaparsec.ParseError Char Void type QueryFunc = NodeName -> IO (Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) data MultNodes@@ -178,8 +176,12 @@ unifyFacts :: Container PValue -> Container PValue -> Container PValue -> Container PValue unifyFacts defaults override c = override `Map.union` c `Map.union` defaults -parseFile :: FilePath -> IO (Either ParseError' (V.Vector Statement))-parseFile fp = runPParser fp <$> readFile fp+parseFile :: FilePath -> IO (V.Vector Statement)+parseFile fp = do+ s <- readFile fp+ case runPuppetParser fp s of+ Left err -> putDoc (red "ERROR:" <+> getError (prettyParseError s err)) *> exitFailure+ Right r -> pure r printContent :: Text -> FinalCatalog -> IO () printContent filename catalog =@@ -233,7 +235,9 @@ unless (Set.null deadfiles) $ do putDoc ("The following files" <+> pretty (Set.size deadfiles) <+> "are not used: " <> list (map ppstring $ Set.toList deadfiles)) putText ""- allparses <- parallel (map parseFile (Set.toList usedfiles))+ allparses <- do+ let parsefp fp = runPuppetParser fp <$> readFile fp+ parallel (map (parsefp) (Set.toList usedfiles)) let (parseFailed, parseSucceeded) = partitionEithers allparses unless (null parseFailed) $ do putDoc ("The following" <+> pretty (length parseFailed) <+> "files could not be parsed:" <> softline <> indent 4 (vcat (map (ppstring . show) parseFailed)))@@ -360,11 +364,11 @@ run Options {_optVersion = True, ..} = putStrLn ("language-puppet " ++ Data.Version.showVersion Meta.version) -- Parse mode-run Options {_optParse = Just fp, ..} = parseFile fp >>= \case- Left rr -> panic (toS $ Megaparsec.parseErrorPretty rr)- Right s -> if _optLoglevel == Log.DEBUG- then mapM_ print s- else putDoc $ ppStatements s+run Options {_optParse = Just fp, ..} = do+ sx <- parseFile fp+ if _optLoglevel == Log.DEBUG+ then mapM_ print sx+ else putDoc $ ppStatements sx run Options {_optPuppetdir = Nothing, _optParse = Nothing } = panic "Without a puppet dir, only the `--parse` option can be supported"@@ -384,9 +388,7 @@ where retrieveNodes :: MultNodes -> IO [NodeName] retrieveNodes AllNodes = do- allstmts <- parseFile (workingdir <> "/manifests/site.pp") >>= \case- Left err -> panic (show err)- Right x -> return x+ allstmts <- parseFile (workingdir <> "/manifests/site.pp") let getNodeName (NodeDeclaration (NodeDecl (NodeName n) _ _ _)) = Just n getNodeName _ = Nothing return $ mapMaybe getNodeName (V.toList allstmts)
ruby/hrubyerb.rb view
@@ -1,6 +1,7 @@ require 'erb' require 'digest/md5' require 'yaml'+require 'json' class Scope def initialize(context,variables,filename,stt,rdr)
src/Hiera/Server.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-}@@ -34,6 +33,7 @@ import qualified Data.Text as Text import qualified Data.Vector as Vector import qualified Data.Yaml as Yaml+import qualified System.Directory as Directory import qualified System.FilePath as FilePath import System.FilePath.Lens (directory) @@ -201,15 +201,16 @@ basedir = case datadir of '/' : _ -> mempty _ -> fp ^. directory <> "/"- efilecontent <- Cache.query cache filename (decodefunction filename)- case efilecontent of- S.Left r -> do- let errs = "Hiera: error when reading file " <> ppstring filename <+> ppstring r- if "Yaml file not found: " `List.isInfixOf` r- then logDebug (show errs)- else logWarning (show errs)- return Nothing- S.Right val -> return (Just val)+ querycache = do+ efilecontent <- Cache.query cache filename (decodefunction filename)+ case efilecontent of+ S.Left r -> do+ logWarningStr $ "Hiera: error when reading file " <> filename <> ": "<> r+ pure Nothing+ S.Right val -> pure (Just val)+ ifM (Directory.doesFileExist filename)+ querycache+ (pure Nothing) let vals = catMaybes mvals -- step 3, query through all the results return (strictifyEither $ runReader (runExceptT (recursiveQuery hquery [])) (QRead vars qt vals))
src/Puppet/Interpreter.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} module Puppet.Interpreter@@ -200,7 +199,7 @@ let res = foldl' (\curm e -> curm & at (e ^. rid) ?~ e) realized refinalized return (toList res) - mainstage = Resource (RIdentifier "stage" "main") mempty mempty mempty [ContRoot] Normal mempty dummyppos nodename+ mainstage = Resource (RIdentifier "stage" "main") mempty mempty mempty [ContRoot] Normal mempty (initialPPos mempty) nodename evaluateNode :: NodeDecl -> InterpreterMonad [Resource] evaluateNode (NodeDecl _ sx inheritnode p) = do@@ -834,7 +833,7 @@ mainFunctionCall "debug" a = logWithModifier Log.DEBUG dullwhite a mainFunctionCall "emerg" a = logWithModifier Log.EMERGENCY red a mainFunctionCall "err" a = logWithModifier Log.ERROR dullred a-mainFunctionCall "info" a = logWithModifier Log.INFO green a+mainFunctionCall "info" a = logWithModifier Log.INFO dullgreen a mainFunctionCall "notice" a = logWithModifier Log.NOTICE white a mainFunctionCall "warning" a = logWithModifier Log.WARNING dullyellow a mainFunctionCall "contain" includes =
src/Puppet/Interpreter/Helpers.hs view
@@ -1,5 +1,4 @@ {-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -- | Internal helpers module.@@ -19,16 +18,15 @@ import Facter import Puppet.Interpreter.Types-import Puppet.Parser initialState :: Facts -> Container Text -- ^ Server settings -> InterpreterState initialState facts settings =- InterpreterState baseVars initialclass mempty [ContRoot] dummyppos mempty [] []+ InterpreterState baseVars initialclass mempty [ContRoot] (initialPPos mempty) mempty [] [] where- callervars = Map.fromList [("caller_module_name", PString "::" :!: dummyppos :!: ContRoot), ("module_name", PString "::" :!: dummyppos :!: ContRoot)]+ callervars = Map.fromList [("caller_module_name", PString "::" :!: (initialPPos mempty) :!: ContRoot), ("module_name", PString "::" :!: (initialPPos mempty) :!: ContRoot)] 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' = Map.insert "facts" (PHash facts) facts@@ -37,7 +35,7 @@ baseVars = Map.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) ]- initialclass = mempty & at "::" ?~ (ClassIncludeLike :!: dummyppos)+ initialclass = mempty & at "::" ?~ (ClassIncludeLike :!: (initialPPos mempty)) getModulename :: RIdentifier -> Text getModulename (RIdentifier t n) =@@ -93,7 +91,7 @@ scp <- getScopeName preuse (scopes . ix scp . scopeContainer) >>= \case Just x -> return x- Nothing -> throwPosError ("Internal error: can't find the current container for" <+> green (ppline scp))+ Nothing -> throwPosError ("Internal error: can't find the current container for" <+> ppline scp) rcurcontainer :: Resource -> CurContainerDesc rcurcontainer r = fromMaybe ContRoot (r ^? rscope . _head)@@ -162,5 +160,5 @@ classes = (PArray . Vector.fromList . map PString . Map.keys) (s ^. loadedClasses) scps = s ^. scopes container_desc = fromMaybe ContRoot (scps ^? ix scope_name . scopeContainer . cctype) -- get the current containder description- cscps = scps & ix scope_name . scopeVariables . at "classes" ?~ ( classes :!: dummyppos :!: container_desc )+ cscps = scps & ix scope_name . scopeVariables . at "classes" ?~ ( classes :!: (initialPPos mempty) :!: container_desc ) in Just (scope_name, cscps)
src/Puppet/Interpreter/IO.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs #-} -- | This is an internal module. module Puppet.Interpreter.IO (
src/Puppet/Interpreter/PrettyPrinter.hs view
@@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} module Puppet.Interpreter.PrettyPrinter () where
src/Puppet/Interpreter/Resolve.hs view
@@ -2,8 +2,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE FlexibleContexts #-}- -- | This module is all about converting and resolving foreign data into -- the fully exploitable corresponding data type. --
src/Puppet/Interpreter/Types.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}
src/Puppet/Language/Core.hs view
@@ -14,11 +14,18 @@ showPos :: Position -> Doc-showPos p = green (pretty '#' <+> ppline (show p))+showPos = blue . pptext . sourcePosPretty +-- | showing a position interval only show the first position showPPos :: PPosition -> Doc-showPPos p = green (pretty '#' <+> ppline (show (Tuple.fst p)))+showPPos = showPos . Tuple.fst +-- | Generates an initial position interval based on a filename.+initialPPos :: FilePath -> PPosition+initialPPos x =+ let i = initialPos x+ in (i :!: i)+ -- | A pair containing the start and end of a given token. type PPosition = Pair Position Position @@ -69,7 +76,7 @@ | otherwise = Text.cons (Char.toUpper (Text.head t)) (Text.tail t) containerComma'' :: Pretty a => [(Doc, a)] -> Doc-containerComma'' x = indent 2 ins+containerComma'' x = indent 4 ins where ins = mconcat $ intersperse (comma <> line <> mempty) (fmap showC x) showC (a,b) = a <+> "=>" <+> pretty b
src/Puppet/Language/Resource.hs view
@@ -126,9 +126,9 @@ expandSet (ri, lts) = [(ri, lt) | lt <- Set.toList lts] meta :: Resource -> Doc-meta r = showPPos (r ^. rpos) <+> green (node <+> brackets scp)+meta r = showPPos (r ^. rpos) <+> red node <+> green (brackets scp) where- node = red (ppline (r ^. rnode))+ node = ppline (r ^. rnode) scp = "Scope" <+> pretty (r ^.. rscope . folded . filtered (/=ContRoot) . to pretty) resourceBody :: Resource -> Doc
src/Puppet/Language/Value.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} module Puppet.Language.Value
src/Puppet/Parser.hs view
@@ -3,23 +3,23 @@ {-| Parse puppet source code from text. -} module Puppet.Parser ( -- * Runner- runPParser+ runPuppetParser -- * Parsers , Parser , puppetParser+ , PuppetParseError+ , prettyParseError+ -- ** exposed to ease testing , expression , datatype- -- * Position- , initialPPos- , dummypos- , dummyppos- -- * Pretty Printer+ -- * Pretty Print , module Puppet.Parser.PrettyPrinter , module Puppet.Parser.Types , module Puppet.Parser.Lens ) where import XPrelude.Extra hiding (option, try, many, some)+import XPrelude.PP hiding (braces, comma, brackets, parens, sep) import qualified Data.Char as Char import qualified Data.List as List@@ -28,9 +28,9 @@ import qualified Data.Scientific as Scientific import qualified Data.Text as Text import qualified Data.Vector as V-import Text.Megaparsec hiding (token)+import Text.Megaparsec import Text.Megaparsec.Char-import qualified Text.Megaparsec.Char.Lexer as L+import qualified Text.Megaparsec.Char.Lexer as Lexer import Text.Megaparsec.Expr import qualified Text.Regex.PCRE.ByteString.Utils as Regex @@ -39,29 +39,37 @@ import Puppet.Parser.PrettyPrinter import Puppet.Parser.Types ++type PuppetParseError = ParseError Char Void type Parser = Parsec Void Text --- | Run a puppet parser against some 'Text' input.-runPParser :: String -> Text -> Either (ParseError Char Void) (Vector Statement)-runPParser = parse puppetParser+-- | Build a 'PrettyError' from a 'ParseError' given the text source.+-- The source is used to display the line on which the error occurs.+prettyParseError :: Text -> ParseError Char Void -> PrettyError+prettyParseError s err = PrettyError $ "cannot parse" <+> pretty (parseErrorPretty' s err) -someSpace :: Parser ()-someSpace = L.space (skipSome spaceChar) (L.skipLineComment "#") (L.skipBlockComment "/*" "*/")+-- | Run a puppet parser against some 'Text' input.+runPuppetParser :: String -> Text -> Either PuppetParseError (Vector Statement)+runPuppetParser src input = parse puppetParser src input -token :: Parser a -> Parser a-token = L.lexeme someSpace+-- space consumer+sc :: Parser ()+sc = Lexer.space space1 (Lexer.skipLineComment "#") (Lexer.skipBlockComment "/*" "*/") -integerOrDouble :: Parser (Either Integer Double)-integerOrDouble = fmap Left hex <|> (either Right Left . Scientific.floatingOrInteger <$> L.scientific)- where- hex = string "0x" *> L.hexadecimal+lexeme :: Parser a -> Parser a+lexeme = Lexer.lexeme sc symbol :: Text -> Parser ()-symbol = void . try . L.symbol someSpace+symbol = void . Lexer.symbol sc symbolic :: Char -> Parser () symbolic = symbol . Text.singleton +integerOrDouble :: Parser (Either Integer Double)+integerOrDouble = fmap Left hex <|> (either Right Left . Scientific.floatingOrInteger <$> Lexer.scientific)+ where+ hex = string "0x" *> Lexer.hexadecimal+ braces :: Parser a -> Parser a braces = between (symbol "{") (symbol "}") @@ -82,18 +90,18 @@ -- | Parse a collection of puppet 'Statement'. puppetParser :: Parser (Vector Statement)-puppetParser = optional someSpace >> statementList+puppetParser = optional sc >> statementList --- | Parse a puppet 'Expression'.+-- | Parse an 'Expression'. expression :: Parser Expression expression = condExpression- <|> makeExprParser (token terminal) expressionTable+ <|> makeExprParser (lexeme terminal) expressionTable <?> "expression" where condExpression = do selectedExpression <- try $ do- trm <- token terminal+ trm <- lexeme terminal lookups <- optional indexLookupChain symbolic '?' return $ maybe trm ($ trm) lookups@@ -133,7 +141,7 @@ identl :: Parser Char -> Parser Char -> Parser Text identl fstl nxtl = do f <- fstl- nxt <- token $ many nxtl+ nxt <- lexeme $ many nxtl return $ Text.pack $ f : nxt operator :: Text -> Parser ()@@ -144,7 +152,7 @@ try $ do void (string s) notFollowedBy (satisfy identifierPart)- someSpace+ sc variableName :: Parser Text variableName = do@@ -155,7 +163,7 @@ return out qualif :: Parser Text -> Parser Text-qualif p = token $ do+qualif p = lexeme $ do header <- option "" (string "::") ( header <> ) . Text.intercalate "::" <$> p `sepBy1` string "::" @@ -268,7 +276,7 @@ -- include foo::bar let argsc sep e = (fmap (Terminal . UString) (qualif1 className) <|> e <?> "Function argument A") `sep` comma terminalF = terminalG (fail "function hack")- expressionF = makeExprParser (token terminalF) expressionTable <?> "function expression"+ expressionF = makeExprParser (lexeme terminalF) expressionTable <?> "function expression" withparens = parens (argsc sepEndBy expression) withoutparens = argsc sepEndBy1 expressionF args <- withparens <|> if nonparens@@ -278,7 +286,7 @@ literalValue :: Parser UnresolvedValue-literalValue = token (fmap UString stringLiteral' <|> fmap UString bareword <|> fmap UNumber numericalvalue <?> "Literal Value")+literalValue = lexeme (fmap UString stringLiteral' <|> fmap UString bareword <|> fmap UNumber numericalvalue <?> "Literal Value") where numericalvalue = integerOrDouble >>= \i -> case i of Left x -> return (fromIntegral x)@@ -466,8 +474,6 @@ depOperator = (operator "->" *> pure RBefore) <|> (operator "~>" *> pure RNotify) -- assignment :: Parser AttributeDecl assignment = AttributeDecl <$> key <*> arrowOp <*> expression where@@ -478,7 +484,7 @@ <|> (symbol "+>" *> pure AppendArrow) searchExpression :: Parser SearchExpression-searchExpression = makeExprParser (token searchterm) searchTable+searchExpression = makeExprParser (lexeme searchterm) searchTable where searchTable :: [[Operator Parser SearchExpression]] searchTable = [ [ InfixL ( reserved "and" >> return AndSearch )@@ -499,7 +505,7 @@ e <- option AlwaysTrue searchExpression void (char '|') void (count (length openchev) (char '>'))- someSpace+ sc overrides <- option [] $ braces (sepComma assignment) let collectortype = if length openchev == 1 then Collector@@ -756,15 +762,3 @@ [a] -> return (BPSingle a) [a,b] -> return (BPPair a b) _ -> fail "Invalid number of variables between the pipes"---- | Generates an initial position based on a filename.-initialPPos :: Text -> PPosition-initialPPos x =- let i = initialPos (toS x)- in (i :!: i)--dummyppos :: PPosition-dummyppos = initialPPos "dummy"--dummypos :: Position-dummypos = initialPos "dummy"
src/Puppet/Parser/Lens.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} module Puppet.Parser.Lens (
src/Puppet/Runner/Daemon/FileParser.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs #-} module Puppet.Runner.Daemon.FileParser (parseFunc) where import XPrelude@@ -22,7 +21,7 @@ -- | Return an HOF that would parse the file associated with a toplevel. -- The toplevel is defined by the tuple (type, name) -- The result of the parsing is a single Statement (which recursively contains others statements)-parseFunc :: PuppetDirPaths -> FileCache (V.Vector Statement) -> MStats -> TopLevelType -> Text -> IO (S.Either PrettyError Statement)+parseFunc :: PuppetDirPaths -> FileCacheR PrettyError (V.Vector Statement) -> MStats -> TopLevelType -> Text -> IO (S.Either PrettyError Statement) parseFunc ppath filecache stats = \toptype topname -> let nameparts = Text.splitOn "::" topname in let topLevelFilePath :: TopLevelType -> Text -> Either PrettyError Text@@ -36,20 +35,20 @@ Left rr -> return (S.Left rr) Right fname -> do let sfname = Text.unpack fname- handleFailure :: SomeException -> IO (S.Either String (V.Vector Statement))- handleFailure e = return (S.Left (show e))- x <- measure stats fname (FileCache.query filecache sfname (parseFile sfname `catch` handleFailure))+ x <- measure stats fname (FileCache.query filecache sfname (parseFile sfname)) case x of S.Right stmts -> filterStatements toptype topname stmts- S.Left rr -> return (S.Left (PrettyError (red (pptext rr))))+ S.Left rr -> return (S.Left rr) -parseFile :: FilePath -> IO (S.Either String (V.Vector Statement))+parseFile :: FilePath -> IO (S.Either PrettyError (V.Vector Statement)) parseFile fname = do traceEventIO ("START parsing " ++ fname) cnt <- readFile fname- o <- case runPParser fname cnt of+ o <- case runPuppetParser fname cnt of Right r -> traceEventIO ("Stopped parsing " ++ fname) >> return (S.Right r)- Left rr -> traceEventIO ("Stopped parsing " ++ fname ++ " (failure: " ++ Megaparsec.parseErrorPretty rr ++ ")") >> return (S.Left (Megaparsec.parseErrorPretty rr))+ Left rr -> do+ traceEventIO ("Stopped parsing " ++ fname ++ " (failure: " ++ Megaparsec.parseErrorPretty rr ++ ")")+ pure (S.Left $ prettyParseError cnt rr) traceEventIO ("STOP parsing " ++ fname) return o
src/Puppet/Runner/Preferences.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}
src/PuppetDB/TestDB.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}
src/XPrelude.hs view
@@ -1,3 +1,7 @@+{-|+General specific prelude for language-puppet.+Customization of the <https://hackage.haskell.org/package/protolude Protolude> with extra specific utilities.+-} module XPrelude ( module XPrelude.Extra , module XPrelude.PP
src/XPrelude/Extra.hs view
@@ -1,8 +1,5 @@ {-# OPTIONS_HADDOCK ignore-exports #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}--- | General specific prelude for language-puppet--- | Customization of the Protolude with extra specific utilities. module XPrelude.Extra ( module Exports , String@@ -10,7 +7,6 @@ , unwrapError , isEmpty , dropInitialColons- , textElem , getDirectoryContents , takeBaseName , strictifyEither@@ -24,6 +20,7 @@ , logInfo , logInfoStr , logWarning+ , logWarningStr , logError , logDebugStr ) where@@ -83,10 +80,6 @@ strictifyEither (Left x) = S.Left x strictifyEither (Right x) = S.Right x -textElem :: Char -> Text -> Bool-textElem c = Text.any (==c)-- -- | See "System.FilePath.Posix" takeBaseName :: Text -> Text takeBaseName fullname =@@ -171,6 +164,9 @@ logWarning :: Text -> IO () logWarning = Log.warningM "language-puppet" . toS++logWarningStr :: String -> IO ()+logWarningStr = Log.warningM "language-puppet" logError :: Text -> IO () logError = Log.errorM "language-puppet" . toS
tests/Function/DeleteAtSpec.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE FlexibleContexts #-} module Function.DeleteAtSpec (spec, main) where
tests/Function/MergeSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedLists #-} module Function.MergeSpec (spec, main) where
tests/Function/SizeSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedLists #-} module Function.SizeSpec (spec, main) where
tests/Helpers.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLists #-} module Helpers ( module Exports@@ -28,7 +27,7 @@ compileCatalog :: MonadError String m => Text -> m (FinalCatalog, EdgeMap, FinalCatalog, [Resource], InterpreterState) compileCatalog input = do- statements <- either (throwError . show) return (runPParser "dummy" input)+ statements <- either (throwError . show) return (runPuppetParser mempty input) let nodename = "node.fqdn" sttmap = [((TopNode, nodename), NodeDeclaration (NodeDecl (NodeName nodename) statements S.Nothing (initialPPos "dummy")))
tests/InterpreterSpec.hs view
@@ -71,7 +71,7 @@ getStatement :: NodeName -> Text -> HashMap (TopLevelType, NodeName) Statement getStatement n i = HM.fromList [ ((TopNode, n), nodeStatement i)- , ((TopClass, "foo"), ClassDeclaration $ ClassDecl mempty mempty mempty mempty (initialPPos "dummy"))+ , ((TopClass, "foo"), ClassDeclaration $ ClassDecl mempty mempty mempty mempty (initialPPos mempty)) ] nodeStatement :: Text -> Statement