{-# LANGUAGE LambdaCase #-}
module Erb.Parser where
import Puppet.Prelude hiding (option, try)
import Control.Exception (catch)
import qualified Data.Text as Text
import Text.Parsec.Char
import Text.Parsec.Combinator hiding (optional)
import Text.Parsec.Error
import Text.Parsec.Expr
import Text.Parsec.Language (emptyDef)
import Text.Parsec.Pos
import Text.Parsec.Prim hiding (many, (<|>))
import Text.Parsec.String
import qualified Text.Parsec.Token as P
import Erb.Ruby
def :: P.GenLanguageDef String u Identity
def = emptyDef
{ P.commentStart = "/*"
, P.commentEnd = "*/"
, P.commentLine = "#"
, P.nestedComments = True
, P.identStart = letter
, P.identLetter = alphaNum <|> oneOf "_"
, P.reservedNames = ["if", "else", "case", "elsif"]
, P.reservedOpNames= ["=>","=","+","-","/","*","+>","->","~>","!"]
, P.caseSensitive = True
}
lexer :: P.GenTokenParser String u Identity
lexer = P.makeTokenParser def
parens :: Parser a -> Parser a
parens = P.parens lexer
braces :: Parser a -> Parser a
braces = P.braces lexer
operator :: Parser String
operator = P.operator lexer
symbol :: String -> Parser String
symbol = P.symbol lexer
reservedOp :: String -> Parser ()
reservedOp = P.reservedOp lexer
whiteSpace :: Parser ()
whiteSpace = P.whiteSpace lexer
naturalOrFloat :: Parser (Either Integer Double)
naturalOrFloat = P.naturalOrFloat lexer
identifier :: Parser String
identifier = P.identifier lexer
rubyexpression :: Parser Expression
rubyexpression = buildExpressionParser table term <?> "expression"
table :: [[Operator String () Identity Expression]]
table = [ [ Infix ( reservedOp "+" >> return PlusOperation ) AssocLeft
, Infix ( reservedOp "-" >> return MinusOperation ) AssocLeft ]
, [ Infix ( reservedOp "/" >> return DivOperation ) AssocLeft
, Infix ( reservedOp "*" >> return MultiplyOperation ) AssocLeft ]
, [ Infix ( reservedOp "<<" >> return ShiftLeftOperation ) AssocLeft
, Infix ( reservedOp ">>" >> return ShiftRightOperation ) AssocLeft ]
, [ Infix ( reservedOp "and" >> return AndOperation ) AssocLeft
, Infix ( reservedOp "or" >> return OrOperation ) AssocLeft ]
, [ Infix ( reservedOp "==" >> return EqualOperation ) AssocLeft
, Infix ( reservedOp "!=" >> return DifferentOperation ) AssocLeft ]
, [ Infix ( reservedOp ">" >> return AboveOperation ) AssocLeft
, Infix ( reservedOp ">=" >> return AboveEqualOperation ) AssocLeft
, Infix ( reservedOp "<=" >> return UnderEqualOperation ) AssocLeft
, Infix ( reservedOp "<" >> return UnderOperation ) AssocLeft ]
, [ Infix ( reservedOp "=~" >> return RegexpOperation ) AssocLeft
, Infix ( reservedOp "!~" >> return NotRegexpOperation ) AssocLeft ]
, [ Prefix ( symbol "!" >> return NotOperation ) ]
, [ Prefix ( symbol "-" >> return NegOperation ) ]
, [ Infix ( reservedOp "?" >> return ConditionalValue ) AssocLeft ]
, [ Infix ( reservedOp "." >> return MethodCall ) AssocLeft ]
]
term :: Parser Expression
term
= parens rubyexpression
<|> scopeLookup
<|> stringLiteral
<|> objectterm
<|> variablereference
scopeLookup :: Parser Expression
scopeLookup = do
void $ try $ string "scope"
end <- (string ".lookupvar(" >> return (char ')')) <|> (char '[' >> return (char ']'))
expr <- rubyexpression
void end
return $ Object expr
stringLiteral :: Parser Expression
stringLiteral = Value `fmap` (doubleQuoted <|> singleQuoted)
doubleQuoted :: Parser Value
doubleQuoted = Interpolable <$> between (char '"') (char '"') quoteInternal
where
quoteInternal = many (basicContent <|> interpvar <|> escaped)
escaped = char '\\' >> (Value . Literal . Text.singleton) `fmap` anyChar
basicContent = (Value . Literal . Text.pack) `fmap` many1 (noneOf "\"\\#")
interpvar = do
void $ try (string "#{")
o <- many1 (noneOf "}")
void $ char '}'
return (Object (Value (Literal (Text.pack o))))
singleQuoted :: Parser Value
singleQuoted = Literal . Text.pack <$> between (char '\'') (char '\'') (many $ noneOf "'")
objectterm :: Parser Expression
objectterm = do
void $ optional (char '@')
methodname' <- fmap Text.pack identifier
let methodname = Value (Literal methodname')
lookAhead anyChar >>= \case
'[' -> do
hr <- many (symbol "[" *> rubyexpression <* symbol "]")
return $! foldl LookupOperation (Object methodname) hr
'{' -> fmap (MethodCall methodname . BlockOperation . Text.pack) (braces (many1 $ noneOf "}"))
'(' -> fmap (MethodCall methodname . Value . Array) (parens (rubyexpression `sepBy` symbol ","))
_ -> return $ Object methodname
variablereference :: Parser Expression
variablereference = fmap (Object . Value . Literal . Text.pack) identifier
rubystatement :: Parser RubyStatement
rubystatement = fmap Puts rubyexpression
textblockW :: Maybe Char -> Parser [RubyStatement]
textblockW c = do
s <- many (noneOf "<")
let ns = case c of
Just x -> x:s
Nothing -> s
returned = Puts $ Value $ Literal $ Text.pack ns
optionMaybe eof >>= \case
Just _ -> return [returned]
Nothing -> do
void $ char '<'
n <- optionMaybe (char '%') >>= \case
Just _ -> rubyblock
Nothing -> textblockW (Just '<')
return (returned : n)
textblock :: Parser [RubyStatement]
textblock = textblockW Nothing
rubyblock :: Parser [RubyStatement]
rubyblock = do
ps <- option [] (char '-' >> return [DropPrevSpace'])
parsed <- optionMaybe (char '=') >>= \case
Just _ -> spaces >> fmap (return . Puts) rubyexpression
Nothing -> spaces >> many1 rubystatement
spaces
let dn (x:xs) = DropNextSpace x : xs
dn x = x
ns <- option identity (char '-' >> return dn)
void $ string "%>"
n <- textblock
return (ps ++ parsed ++ ns n)
erbparser :: Parser [RubyStatement]
erbparser = textblock
parseErbFile :: FilePath -> IO (Either ParseError [RubyStatement])
parseErbFile fname = parseContent `catch` handler
where
parseContent = (runParser erbparser () fname . Text.unpack) `fmap` readFile fname
handler e = let msg = show (e :: SomeException)
in return $ Left $ newErrorMessage (Message msg) (initialPos fname)
parseErbString :: String -> Either ParseError [RubyStatement]
parseErbString = runParser erbparser () "dummy"