language-puppet 0.11.1.1 → 0.12.0
raw patch · 16 files changed
+195/−117 lines, 16 filesdep ~basedep ~filecachedep ~hruby
Dependency ranges changed: base, filecache, hruby, lens, parsec, parsers, process, stateWriter, strict-base-types, text, unix
Files
- Erb/Compute.hs +10/−9
- Erb/Evaluate.hs +20/−3
- Erb/Parser.hs +35/−18
- Erb/Ruby.hs +7/−1
- Puppet/Interpreter.hs +3/−0
- Puppet/Interpreter/Resolve.hs +8/−7
- Puppet/Interpreter/Types.hs +22/−7
- Puppet/NativeTypes/Cron.hs +5/−4
- Puppet/NativeTypes/Helpers.hs +9/−10
- Puppet/Parser.hs +17/−8
- Puppet/Utils.hs +4/−21
- SafeProcess.hs +5/−1
- language-puppet.cabal +27/−23
- tests/erb.hs +19/−0
- tests/expr.hs +2/−2
- tests/lexer.hs +2/−3
Erb/Compute.hs view
@@ -134,17 +134,18 @@ getRubyScriptPath :: String -> IO String getRubyScriptPath rubybin = do- cabalPath <- getDataFileName $ "ruby/" ++ rubybin :: IO FilePath- exists <- fileExist cabalPath- if exists- then return cabalPath- else do+ let checkpath :: FilePath -> (IO FilePath) -> IO FilePath+ checkpath fp nxt = do+ e <- fileExist fp+ if e+ then return fp+ else nxt+ withExecutablePath = do path <- fmap (T.unpack . takeDirectory . T.pack) getExecutablePath let fullpath = path <> "/" <> rubybin- lexists <- fileExist cabalPath- return $ if lexists- then fullpath- else rubybin+ checkpath fullpath $ checkpath ("/usr/local/bin/" <> rubybin) (return rubybin)+ cabalPath <- getDataFileName $ "ruby/" ++ rubybin :: IO FilePath+ checkpath cabalPath withExecutablePath #ifdef HRUBY -- This must be called from the proper thread. As this is callback, this
Erb/Evaluate.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+-- | Evaluates a ruby template from what's generated by "Erb.Parser". module Erb.Evaluate (rubyEvaluate, getVariable) where import Puppet.PP@@ -11,12 +12,28 @@ import Puppet.Utils import Control.Lens import qualified Data.Vector as V+import Data.Char (isSpace)+import Data.Attoparsec.Number rubyEvaluate :: Container ScopeInformation -> T.Text -> [RubyStatement] -> Either Doc T.Text-rubyEvaluate vars ctx = foldl (evalruby vars ctx) (Right "")+rubyEvaluate vars ctx = foldl (evalruby vars ctx) (Right "") . optimize+ where+ optimize [] = []+ optimize (Puts x : DropPrevSpace' : xs) = optimize $ DropPrevSpace (Puts x) : xs+ optimize (x:xs) = x : optimize xs +spaceNotCR :: Char -> Bool+spaceNotCR c = isSpace c && c /= '\n' && c /= '\r'+ evalruby :: Container ScopeInformation -> T.Text -> Either Doc T.Text -> RubyStatement -> Either Doc T.Text evalruby _ _ (Left err) _ = Left err+evalruby _ _ (Right _) (DropPrevSpace') = Left "Could not evaluate a non optimize DropPrevSpace'"+evalruby mp ctx (Right curstr) (DropNextSpace x) = case evalruby mp ctx (Right curstr) x of+ Left err -> Left err+ Right y -> Right (T.dropWhile spaceNotCR y)+evalruby mp ctx (Right curstr) (DropPrevSpace x) = case evalruby mp ctx (Right curstr) x of+ Left err -> Left err+ Right y -> Right (T.dropWhileEnd spaceNotCR y) evalruby mp ctx (Right curstr) (Puts e) = case evalExpression mp ctx e of Left err -> Left err Right ex -> Right (curstr <> ex)@@ -45,6 +62,6 @@ evalValue x = Right $ tshow x a2i :: T.Text -> Maybe Int-a2i x = case readDecimal x of- Right y -> Just y+a2i x = case text2Number x of+ Just (I y) -> Just (fromIntegral y) _ -> Nothing
Erb/Parser.hs view
@@ -2,10 +2,10 @@ module Erb.Parser where import Text.Parsec.String-import Text.Parsec.Prim+import Text.Parsec.Prim hiding ((<|>),many) import Text.Parsec.Char import Text.Parsec.Error-import Text.Parsec.Combinator+import Text.Parsec.Combinator hiding (optional) import Text.Parsec.Language (emptyDef) import Erb.Ruby import Text.Parsec.Expr@@ -15,6 +15,7 @@ import qualified Data.Text.IO as T import Control.Monad.Identity import Control.Exception (catch,SomeException)+import Control.Applicative def :: P.GenLanguageDef String u Identity def = emptyDef@@ -91,28 +92,40 @@ scopeLookup :: Parser Expression scopeLookup = do- void $ try $ string "scope.lookupvar("+ void $ try $ string "scope"+ end <- (string ".lookupvar(" >> return (char ')')) <|> (char '[' >> return (char ']')) expr <- rubyexpression- void $ char ')'+ void $ end return $ Object expr -blockinfo :: Parser String-blockinfo = many1 $ noneOf "}"- stringLiteral :: Parser Expression-stringLiteral = doubleQuoted <|> singleQuoted+stringLiteral = Value `fmap` (doubleQuoted <|> singleQuoted) -doubleQuoted :: Parser Expression-doubleQuoted = fmap (Value . Literal . T.pack) $ between (char '"') (char '"') (many $ noneOf "\"")+doubleQuoted :: Parser Value+doubleQuoted = fmap Interpolable $ between (char '"') (char '"') quoteInternal+ where+ quoteInternal = many (basicContent <|> interpvar <|> escaped)+ escaped = char '\\' >> (Value . Literal . T.singleton) `fmap` anyChar+ basicContent = (Value . Literal . T.pack) `fmap` many1 (noneOf "\"\\#")+ interpvar = do+ void $ try (string "#{")+ o <- many1 (noneOf "}")+ void $ char '}'+ return (Object (Value (Literal (T.pack o)))) -singleQuoted :: Parser Expression-singleQuoted = fmap (Value . Literal . T.pack) $ between (char '\'') (char '\'') (many $ noneOf "'")+singleQuoted :: Parser Value+singleQuoted = fmap (Literal . T.pack) $ between (char '\'') (char '\'') (many $ noneOf "'") objectterm :: Parser Expression objectterm = do- methodname <- fmap (Value . Literal . T.pack) identifier+ void $ optional (char '@')+ methodname' <- fmap T.pack identifier+ let methodname = Value (Literal methodname') lookAhead anyChar >>= \case- '{' -> fmap (MethodCall methodname . BlockOperation . T.pack) (braces blockinfo)+ '[' -> do+ hr <- many (symbol "[" *> rubyexpression <* symbol "]")+ return $! foldl LookupOperation (Object methodname) hr+ '{' -> fmap (MethodCall methodname . BlockOperation . T.pack) (braces (many1 $ noneOf "}")) '(' -> fmap (MethodCall methodname . Value . Array) (parens (rubyexpression `sepBy` symbol ",")) _ -> return $ Object methodname @@ -143,13 +156,17 @@ rubyblock :: Parser [RubyStatement] rubyblock = do+ ps <- option [] (char '-' >> return [DropPrevSpace']) parsed <- optionMaybe (char '=') >>= \case- Just _ -> spaces >> fmap Puts rubyexpression- Nothing -> spaces >> rubystatement+ Just _ -> spaces >> fmap (return . Puts) rubyexpression+ Nothing -> spaces >> many1 rubystatement spaces- void $ try $ string "%>"+ let dn (x:xs) = DropNextSpace x : xs+ dn x = x+ ns <- option id (char '-' >> return dn)+ void $ string "%>" n <- textblock- return (parsed : n)+ return (ps ++ parsed ++ ns n) erbparser :: Parser [RubyStatement] erbparser = textblock
Erb/Ruby.hs view
@@ -1,3 +1,4 @@+-- | Base types for the internal ruby parser ("Erb.Parser"). module Erb.Ruby where import qualified Data.Text as T@@ -5,6 +6,8 @@ data Value = Literal !T.Text+ | Interpolable ![Expression]+ | Symbol !T.Text | Array ![Expression] deriving (Show, Ord, Eq) @@ -48,5 +51,8 @@ data RubyStatement = Puts !Expression- deriving(Show)+ | DropPrevSpace !RubyStatement+ | DropPrevSpace'+ | DropNextSpace !RubyStatement+ deriving(Show,Eq)
Puppet/Interpreter.hs view
@@ -162,6 +162,9 @@ mainstage = Resource (RIdentifier "stage" "main") mempty mempty mempty [ContRoot] Normal mempty (initialPPos "dummy") ndename resnode <- evaluateNode node >>= finalStep . (++ (mainstage : restop)) let (real :!: exported) = foldl' classify (mempty :!: mempty) resnode+ classify :: Pair (HM.HashMap RIdentifier Resource) (HM.HashMap RIdentifier Resource)+ -> Resource+ -> Pair (HM.HashMap RIdentifier Resource) (HM.HashMap RIdentifier Resource) classify (curr :!: cure) r = let i curm = curm & at (r ^. rid) ?~ r in case r ^. rvirtuality of
Puppet/Interpreter/Resolve.hs view
@@ -24,6 +24,7 @@ hfGenerateAssociations, hfSetvars, hfRestorevars,+ toNumbers ) where import Puppet.PP@@ -53,7 +54,6 @@ import Control.Lens import Data.Aeson.Lens hiding (key) import Data.Attoparsec.Number-import Data.Attoparsec.Text import qualified Data.Either.Strict as S import qualified Data.Maybe.Strict as S import Text.Regex.PCRE.ByteString@@ -97,12 +97,13 @@ -- that they are of the same type toNumbers :: PValue -> PValue -> S.Maybe NumberPair toNumbers (PString a) (PString b) =- case parseOnly number a :!: parseOnly number b of- (Right (I x) :!: Right (I y)) -> S.Just (S.Left (x :!: y))- (Right (D x) :!: Right (D y)) -> S.Just (S.Right (x :!: y))- (Right (I x) :!: Right (D y)) -> S.Just (S.Right (fromIntegral x :!: y))- (Right (D x) :!: Right (I y)) -> S.Just (S.Right (x :!: fromIntegral y))- _ -> S.Nothing+ let t2s = fmap scientific2Number . text2Scientific+ in case t2s a :!: t2s b of+ (Just (I x) :!: Just (I y)) -> S.Just (S.Left (x :!: y))+ (Just (D x) :!: Just (D y)) -> S.Just (S.Right (x :!: y))+ (Just (I x) :!: Just (D y)) -> S.Just (S.Right (fromIntegral x :!: y))+ (Just (D x) :!: Just (I y)) -> S.Just (S.Right (x :!: fromIntegral y))+ _ -> S.Nothing toNumbers _ _ = S.Nothing -- | This tries to run a numerical binary operation on two puppet
Puppet/Interpreter/Types.hs view
@@ -8,7 +8,7 @@ import Text.Parsec.Pos import Data.Aeson as A-import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>),rational) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import qualified Data.Text as T@@ -35,7 +35,7 @@ import GHC.Stack import Data.Maybe (fromMaybe) import Data.Attoparsec.Number-import Data.Attoparsec.Text (parseOnly,number)+import Data.Attoparsec.Text (parseOnly,rational) import Data.Scientific #ifdef HRUBY@@ -361,7 +361,7 @@ instance FromJSON PValue where parseJSON Null = return PUndef- parseJSON (Number n) = return (PString (T.pack (show n)))+ parseJSON (Number n) = return (PString (T.pack (show (scientific2Number n)))) parseJSON (String s) = return (PString s) parseJSON (Bool b) = return (PBoolean b) parseJSON (Array v) = fmap PArray (V.mapM parseJSON v)@@ -654,6 +654,22 @@ <*> v .: "report_timestamp" parseJSON _ = fail "invalide node info" +text2Scientific :: T.Text -> Maybe Scientific+text2Scientific t = case parseOnly rational t of+ Left _ -> Nothing+ Right s -> Just s++scientific2Number :: Scientific -> Number+scientific2Number s =+ let e = base10Exponent s+ c = coefficient s+ in if e >= 0+ then I (c * 10 ^ e)+ else D ((fromInteger c / 10 ^ negate e) :: Double)++text2Number :: T.Text -> Maybe Number+text2Number = fmap scientific2Number . text2Scientific+ instance AsNumber PValue where _Number = prism num2PValue toNumber where@@ -665,9 +681,8 @@ then show (c * 10 ^ e) else show ( (fromInteger c / 10 ^ negate e) :: Double) toNumber :: PValue -> Either PValue Scientific- toNumber p@(PString x) = case parseOnly number x of- Right (I n) -> Right (fromInteger n)- Right (D n) -> Right (fromRational (toRational n))- _ -> Left p+ toNumber p@(PString x) = case text2Scientific x of+ Just o -> Right o+ _ -> Left p toNumber p = Left p
Puppet/NativeTypes/Cron.hs view
@@ -4,11 +4,11 @@ import Puppet.NativeTypes.Helpers import Control.Monad.Error import Puppet.Interpreter.Types-import Puppet.Utils import qualified Data.HashSet as HS import qualified Data.Text as T import Control.Lens import qualified Data.Vector as V+import Data.Attoparsec.Number nativeCron :: (PuppetTypeName, PuppetTypeMethods) nativeCron = ("cron", PuppetTypeMethods validateCron parameterset)@@ -58,9 +58,10 @@ checkint :: T.Text -> Integer -> Integer -> T.Text -> PuppetTypeValidate checkint st mi ma pname res =- case readDecimal st of- Right v -> checkint' v mi ma pname res- Left rr -> Left $ "Invalid value type for parameter" <+> paramname pname <+> ": " <+> red (text rr)+ case text2Number st of+ Just (I v) -> checkint' v mi ma pname res+ Just (D _) -> Left $ "Invalid value type for parameter" <+> paramname pname <+> ": expected an integer"+ Nothing -> Left $ "Invalid value type for parameter" <+> paramname pname <+> ": " <+> red (ttext st) checkint' :: Integer -> Integer -> Integer -> T.Text -> PuppetTypeValidate checkint' i mi ma param res =
Puppet/NativeTypes/Helpers.hs view
@@ -39,6 +39,7 @@ import Puppet.Utils import Control.Lens import qualified Data.Vector as V+import Data.Attoparsec.Number type PuppetTypeName = T.Text @@ -128,10 +129,8 @@ integers param = runarray param integer'' integer'' :: T.Text -> PValue -> PuppetTypeValidate-integer'' param val res = case val of- PString x -> if T.all isDigit x- then Right res- else Left $ "Parameter" <+> paramname param <+> "should be an integer"+integer'' param val res = case puppet2number val of+ Just (I v) -> Right (res & rattributes . at param ?~ PString (T.pack (show v))) _ -> Left $ "Parameter" <+> paramname param <+> "must be an integer" -- | Copies the "name" value into the parameter if this is not set. It implies@@ -222,11 +221,11 @@ na = va >>= puppet2number in case (va,na) of (Nothing, _) -> Right res- (_,Just (Left v)) -> if (v >= fromIntegral mi) && (v <= fromIntegral ma)- then Right res- else Left $ "Parameter" <+> paramname param P.<> "'s value should be between" <+> P.integer mi <+> "and" <+> P.integer ma- (_,Just (Right v)) -> if (v>=mi) && (v<=ma)- then Right res- else Left $ "Parameter" <+> paramname param P.<> "'s value should be between" <+> P.integer mi <+> "and" <+> P.integer ma+ (_,Just (D v)) -> if (v >= fromIntegral mi) && (v <= fromIntegral ma)+ then Right res+ else Left $ "Parameter" <+> paramname param P.<> "'s value should be between" <+> P.integer mi <+> "and" <+> P.integer ma+ (_,Just (I v)) -> if (v>=mi) && (v<=ma)+ then Right res+ else Left $ "Parameter" <+> paramname param P.<> "'s value should be between" <+> P.integer mi <+> "and" <+> P.integer ma (Just x,_) -> Left $ "Parameter" <+> paramname param <+> "should be an integer, and not" <+> pretty x
Puppet/Parser.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE LambdaCase, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase, GeneralizedNewtypeDeriving, StandaloneDeriving,+FlexibleContexts #-} module Puppet.Parser (puppetParser,expression,runMyParser) where import qualified Data.Text as T@@ -28,18 +29,26 @@ import qualified Text.Parsec.Prim as PP import Text.Parsec.Text () -newtype Parser a = Parser { unParser :: PP.ParsecT T.Text () IO a }- deriving (Functor, Monad, Parsing, LookAheadParsing, CharParsing, Applicative, Alternative, MonadIO)+newtype ParserT m a = ParserT { unParser :: m a }+ deriving (Functor, Applicative, Alternative) +deriving instance Monad m => Monad (ParserT m)+deriving instance MonadIO m => MonadIO (ParserT m)+deriving instance (Monad m, Parsing m) => Parsing (ParserT m)+deriving instance (Monad m, CharParsing m) => CharParsing (ParserT m)+deriving instance (Monad m, LookAheadParsing m) => LookAheadParsing (ParserT m)++type Parser = ParserT (PP.ParsecT T.Text () IO)+ getPosition :: Parser SourcePos-getPosition = Parser PP.getPosition+getPosition = ParserT PP.getPosition runMyParser :: Parser a -> SourceName -> T.Text -> IO (Either ParseError a)-runMyParser (Parser p) = PP.runPT p ()+runMyParser (ParserT p) = PP.runPT p () type OP = PP.ParsecT T.Text () IO -instance TokenParsing Parser where+instance (CharParsing m, Monad m) => TokenParsing (ParserT m) where someSpace = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment) where simpleSpace = skipSome (satisfy isSpace)@@ -215,7 +224,7 @@ -- include foo::bar let argsc sep e = (fmap (PValue . UString) (qualif1 className) <|> e <?> "Function argument A") `sep` comma terminalF = terminalG (fail "function hack")- expressionF = Parser (buildExpressionParser expressionTable (unParser (token terminalF)) <?> "function expression")+ expressionF = ParserT (buildExpressionParser expressionTable (unParser (token terminalF)) <?> "function expression") withparens = parens (argsc sepEndBy expression) withoutparens = argsc sepEndBy1 expressionF args <- withparens <|> if nonparens@@ -264,7 +273,7 @@ expression :: Parser Expression expression = condExpression- <|> Parser (buildExpressionParser expressionTable (unParser (token terminal)))+ <|> ParserT (buildExpressionParser expressionTable (unParser (token terminal))) <?> "expression" where condExpression = do
Puppet/Utils.hs view
@@ -1,7 +1,5 @@ module Puppet.Utils- ( readDecimal- , readRational- , puppet2number+ ( puppet2number , textElem , module Data.Monoid , getDirectoryContents@@ -12,35 +10,20 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T-import qualified Data.Text.Read as T import qualified Data.ByteString as BS import Data.Monoid import System.Posix.Directory.ByteString import qualified Data.Either.Strict as S +import Data.Attoparsec.Number import Puppet.Interpreter.Types strictifyEither :: Either a b -> S.Either a b strictifyEither (Left x) = S.Left x strictifyEither (Right x) = S.Right x -readDecimal :: (Integral a) => T.Text -> Either String a-readDecimal t = case T.signed T.decimal t of- Right (x, "") -> Right x- Right _ -> Left "Trailing characters when reading an integer"- Left r -> Left r--readRational :: Fractional a => T.Text -> Either String a-readRational t = case T.signed T.rational t of- Right (x, "") -> Right x- Right _ -> Left "Trailing characters when reading an integer"- Left r -> Left r--puppet2number :: PValue -> Maybe (Either Double Integer)-puppet2number (PString s) = case (readDecimal s, readRational s) of- (Right i,_) -> Just (Right i)- (_,Right d) -> Just (Left d)- _ -> Nothing+puppet2number :: PValue -> Maybe Number+puppet2number (PString s) = text2Number s puppet2number _ = Nothing textElem :: Char -> T.Text -> Bool
SafeProcess.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase, CPP #-} -- from http://stackoverflow.com/questions/8820903/haskell-how-to-timeout-a-function-that-runs-an-external-command module SafeProcess where @@ -63,7 +63,11 @@ terminateProcessGroup :: ProcessHandle -> IO () terminateProcessGroup ph = do+#if MIN_VERSION_base(4,7,0)+ let (ProcessHandle pmvar _) = ph+#else let (ProcessHandle pmvar) = ph+#endif readMVar pmvar >>= \case OpenHandle pid -> do -- pid is a POSIX pid signalProcessGroup 15 pid
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 0.11.1.1+version: 0.12.0 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/@@ -50,14 +50,14 @@ , PuppetDB.Dummy , PuppetDB.Common , Hiera.Server- , Puppet.Lens- other-modules: Puppet.Utils- , Puppet.NativeTypes.File- , Paths_language_puppet , Erb.Parser , Erb.Ruby , Erb.Evaluate+ , Puppet.Lens+ other-modules: Puppet.Utils+ , Puppet.NativeTypes.File , Erb.Compute+ , Paths_language_puppet , Puppet.Manifests , Puppet.NativeTypes.ZoneRecord , Puppet.NativeTypes.Cron@@ -73,13 +73,13 @@ , Puppet.Interpreter.RubyRandom extensions: OverloadedStrings, BangPatterns if flag(hruby)- Build-depends: hruby >= 0.2 && <0.3+ Build-depends: hruby >= 0.2.5 && <0.3 CPP-Options: -DHRUBY ghc-options: -Wall -funbox-strict-fields ghc-prof-options: -auto-all -caf-all -- other-modules: - build-depends: base ==4.6.*+ build-depends: base >=4.6 && < 4.8 , bytestring , strict-base-types >= 0.2.2 , hashable == 1.2.*@@ -88,32 +88,32 @@ , vector == 0.10.* , parsec == 3.1.* , mtl == 2.1.*- , lens >= 4 && < 5- , parsers >= 0.10 && < 0.11+ , lens >= 4 && < 5+ , parsers >= 0.10.3 && < 0.11 , ansi-wl-pprint == 0.6.*- , unix == 2.6.*+ , unix >= 2.6 && < 2.8 , aeson == 0.7.*- , luautils >= 0.1.3 && < 0.1.4- , hslua >= 0.3.10 && < 0.4+ , luautils >= 0.1.3 && < 0.1.4+ , hslua >= 0.3.10 && < 0.4 , transformers == 0.3.* , hslogger == 1.2.* , time == 1.4.*- , filecache >= 0.2.4 && < 0.3+ , filecache >= 0.2.5 && < 0.3 , regex-pcre-builtin >= 0.94.4 , pcre-utils >= 0.1.0.1 && < 0.2- , process == 1.1.*+ , process >= 1.1 && < 1.3 , iconv == 0.4.* , http-types == 0.8.*- , http-conduit >= 1.9 && <1.10+ , http-conduit >= 1.9 && < 1.10 , attoparsec == 0.11.* , case-insensitive == 1.1.*- , cryptohash >= 0.10 && < 0.12+ , cryptohash >= 0.10 && < 0.12 , base16-bytestring == 0.1.* , containers == 0.5.* , stm == 2.4.*- , hspec >= 1.7.0 && <1.8.0- , yaml >= 0.8.0 && <0.9- , stateWriter == 0.2.*+ , hspec >= 1.7.0 && < 1.8.0+ , yaml >= 0.8.0 && < 0.9+ , stateWriter >= 0.2.1 && < 0.3 , split == 0.2.* , scientific == 0.2.* @@ -129,7 +129,7 @@ type: exitcode-stdio-1.0 ghc-options: -Wall -rtsopts -threaded extensions: OverloadedStrings- build-depends: language-puppet,base,text,parsec,vector,ansi-wl-pprint+ build-depends: language-puppet,base,text,parsers,vector,ansi-wl-pprint main-is: expr.hs Test-Suite test-hiera hs-source-dirs: tests@@ -138,7 +138,6 @@ extensions: OverloadedStrings build-depends: language-puppet,base,hspec,temporary,strict-base-types,HUnit,lens,vector,unordered-containers,text main-is: hiera.hs- Test-Suite test-puppetdb hs-source-dirs: tests type: exitcode-stdio-1.0@@ -146,8 +145,13 @@ extensions: OverloadedStrings build-depends: language-puppet,base,temporary,strict-base-types,lens,text main-is: puppetdb.hs--+Test-Suite erbparser+ hs-source-dirs: tests+ type: exitcode-stdio-1.0+ ghc-options: -Wall -rtsopts -threaded+ extensions: OverloadedStrings+ build-depends: language-puppet,base,strict-base-types,lens,text+ main-is: erb.hs executable puppetresources hs-source-dirs: progs
+ tests/erb.hs view
@@ -0,0 +1,19 @@+module Main where++import System.Environment+import Erb.Parser+import Erb.Ruby+import Control.Monad (when)++checkParse :: FilePath -> IO (Maybe [RubyStatement])+checkParse fp = parseErbFile fp >>= \c ->+ case c of+ Left rr -> print rr >> return Nothing+ Right x -> return (Just x)++main :: IO ()+main = do+ a <- getArgs+ r <- mapM checkParse a+ putStrLn (show (length $ filter (/= Nothing) r) ++ "/" ++ show (length a) ++ " files parsed")+ when (length a == 1) (mapM_ print r)
tests/expr.hs view
@@ -5,7 +5,7 @@ import Puppet.Parser import Puppet.Parser.PrettyPrinter() import Puppet.Parser.Types-import Text.Parsec+import Text.Parser.Combinators import Control.Monad import Data.Maybe import qualified Data.Text as T@@ -22,7 +22,7 @@ main :: IO () main = do testres <- forM testcases $ \(a,b) -> do- na <- runParserT (expression <* eof ) () "tests" a+ na <- runMyParser (expression <* eof) "tests" a return (na, b) let isFailure (Left x, _) = Just (show x) isFailure (Right x, e) = if x == e
tests/lexer.hs view
@@ -4,7 +4,6 @@ import Control.Monad import System.FilePath.Glob import Puppet.Parser-import Text.Parsec import System.Environment import Puppet.Parser.PrettyPrinter import Text.PrettyPrint.ANSI.Leijen@@ -26,7 +25,7 @@ -- returns errors testparser :: FilePath -> IO (String, Bool) testparser fp = do- T.readFile fp >>= runParserT puppetParser () fp >>= \case+ T.readFile fp >>= runMyParser puppetParser fp >>= \case Right _ -> return ("PASS", True) Left rr -> return (show rr, False) @@ -34,7 +33,7 @@ check fname = do putStr fname putStr ": "- res <- T.readFile fname >>= runParserT puppetParser () fname+ res <- T.readFile fname >>= runMyParser puppetParser fname is <- queryTerminal (Fd 1) let rfunc = if is then renderPretty 0.2 200