module Erb.Parser where
import Text.Parsec.String
import Text.Parsec.Prim hiding ((<|>),many)
import Text.Parsec.Char
import Text.Parsec.Error
import Text.Parsec.Combinator hiding (optional)
import Text.Parsec.Language (emptyDef)
import Erb.Ruby
import Text.Parsec.Expr
import Text.Parsec.Pos
import qualified Text.Parsec.Token as P
import qualified Data.Text as T
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
{ 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 . 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 Value
singleQuoted = Literal . T.pack <$> between (char '\'') (char '\'') (many $ noneOf "'")
objectterm :: Parser Expression
objectterm = do
void $ optional (char '@')
methodname' <- fmap T.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 . T.pack) (braces (many1 $ noneOf "}"))
'(' -> fmap (MethodCall methodname . Value . Array) (parens (rubyexpression `sepBy` symbol ","))
_ -> return $ Object methodname
variablereference :: Parser Expression
variablereference = fmap (Object . Value . Literal . T.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 $ T.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 id (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 . T.unpack) `fmap` T.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"