diff --git a/Erb/Compute.hs b/Erb/Compute.hs --- a/Erb/Compute.hs +++ b/Erb/Compute.hs @@ -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 diff --git a/Erb/Evaluate.hs b/Erb/Evaluate.hs --- a/Erb/Evaluate.hs +++ b/Erb/Evaluate.hs @@ -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 diff --git a/Erb/Parser.hs b/Erb/Parser.hs --- a/Erb/Parser.hs +++ b/Erb/Parser.hs @@ -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 diff --git a/Erb/Ruby.hs b/Erb/Ruby.hs --- a/Erb/Ruby.hs +++ b/Erb/Ruby.hs @@ -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) diff --git a/Puppet/Interpreter.hs b/Puppet/Interpreter.hs --- a/Puppet/Interpreter.hs +++ b/Puppet/Interpreter.hs @@ -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 diff --git a/Puppet/Interpreter/Resolve.hs b/Puppet/Interpreter/Resolve.hs --- a/Puppet/Interpreter/Resolve.hs +++ b/Puppet/Interpreter/Resolve.hs @@ -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 diff --git a/Puppet/Interpreter/Types.hs b/Puppet/Interpreter/Types.hs --- a/Puppet/Interpreter/Types.hs +++ b/Puppet/Interpreter/Types.hs @@ -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 diff --git a/Puppet/NativeTypes/Cron.hs b/Puppet/NativeTypes/Cron.hs --- a/Puppet/NativeTypes/Cron.hs +++ b/Puppet/NativeTypes/Cron.hs @@ -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 = diff --git a/Puppet/NativeTypes/Helpers.hs b/Puppet/NativeTypes/Helpers.hs --- a/Puppet/NativeTypes/Helpers.hs +++ b/Puppet/NativeTypes/Helpers.hs @@ -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 diff --git a/Puppet/Parser.hs b/Puppet/Parser.hs --- a/Puppet/Parser.hs +++ b/Puppet/Parser.hs @@ -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 diff --git a/Puppet/Utils.hs b/Puppet/Utils.hs --- a/Puppet/Utils.hs +++ b/Puppet/Utils.hs @@ -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 diff --git a/SafeProcess.hs b/SafeProcess.hs --- a/SafeProcess.hs +++ b/SafeProcess.hs @@ -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 diff --git a/language-puppet.cabal b/language-puppet.cabal --- a/language-puppet.cabal +++ b/language-puppet.cabal @@ -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 diff --git a/tests/erb.hs b/tests/erb.hs new file mode 100644 --- /dev/null +++ b/tests/erb.hs @@ -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) diff --git a/tests/expr.hs b/tests/expr.hs --- a/tests/expr.hs +++ b/tests/expr.hs @@ -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 diff --git a/tests/lexer.hs b/tests/lexer.hs --- a/tests/lexer.hs +++ b/tests/lexer.hs @@ -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