diff --git a/RosettaParser.cabal b/RosettaParser.cabal index 52ed882..8ead6c1 100644 --- a/RosettaParser.cabal +++ b/RosettaParser.cabal @@ -28,7 +28,7 @@ library Model.Enum Model.Function Model.Type - Parser.AnotherExpression + Parser.Expression Parser.Enum Parser.Expr Parser.Expression diff --git a/src/Parser/AnotherExpression.hs b/src/Parser/AnotherExpression.hs deleted file mode 100644 index 42d0325..0000000 --- a/src/Parser/AnotherExpression.hs +++ /dev/null @@ -1,251 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Parser.AnotherExpression where - -import Parser.General -import qualified Data.Text as Text -import Text.Megaparsec -import Text.Megaparsec.Char - -data Expression = Variable String - | Int String - | Real String - | Boolean String - | Empty - | Parens Expression - | List [Expression] - | Function String [Expression] - | PrefixExp String Expression - | PostfixExp String Expression - | InfixExp String Expression Expression - | IfSimple Expression Expression - | IfElse Expression Expression Expression - deriving (Show) - - -expressionParser :: Parser Expression -expressionParser = - choice [ ifParser, - try functionParser, - eqParser] - --------------------------------------------- --- Command Structures ---------------------- --------------------------------------------- - -functionParser :: Parser Expression -functionParser = - do - f <- pascalNameParser - _ <- spaceConsumer - _ <- char '(' - ats <- many $ try (expressionParser >>= \ats -> spaceConsumer >> char ',' >> spaceConsumer >> return ats) - lat <- optional expressionParser - _ <- spaceConsumer - _ <- char ')' - _ <- spaceConsumer - case lat of - Nothing -> return $ Function f [] - Just at -> return $ Function f (ats ++ [at]) - -ifParser :: Parser Expression -ifParser = - do - _ <- string "if" - _ <- spaceConsumer - condition <- between (char '(') (char ')') expressionParser <|> expressionParser - _ <- spaceConsumer - _ <- string "then" - _ <- spaceConsumer - expr <- expressionParser - _ <- spaceConsumer - els <- observing $ string "else" - _ <- spaceConsumer - case els of - Left _ -> return (IfSimple condition expr) - Right _ -> expressionParser >>= \expr2 -> return (IfElse condition expr expr2) - -parens :: Parser a -> Parser a -parens = between (char '(') (char ')') - --------------------------------------------- --- Terminals ------------------------------- --------------------------------------------- - -listParser :: Parser Expression -listParser = - do - _ <- char '[' - _ <- spaceConsumer - expressions <- many $ try (expressionParser >>= \ex -> spaceConsumer >> char ',' >> spaceConsumer >> return ex) - _ <- spaceConsumer - lastExpr <- try expressionParser - _ <- spaceConsumer - _ <- char ']' - _ <- spaceConsumer - return $ List (expressions ++ [lastExpr]) - -variableParser :: Parser Expression -variableParser = - do - var <- camelNameParser - _ <- spaceConsumer - inner <- many innerVariableParser - return $ Variable (var ++ concatMap ("->" ++) inner) - -innerVariableParser :: Parser String -innerVariableParser = - do - _ <- string "->" - _ <- spaceConsumer - var <- camelNameParser - _ <- spaceConsumer - return var - -integerParser :: Parser Expression -integerParser = - do - nr <- some digitChar - _ <- spaceConsumer - return $ Int $ show nr - -decimalParser :: Parser Expression -decimalParser = - do - nr <- some digitChar - _ <- char '.' - real <- many digitChar - _ <- spaceConsumer - return $ Real $ show nr ++ "." ++ real - -booleanParser :: Parser Expression -booleanParser = - do - bol <- string "True" <|> string "False" - _ <- spaceConsumer - return $ Boolean $ Text.unpack bol - -emptyParser :: Parser Expression -emptyParser = - do - _ <- string "empty" - _ <- spaceConsumer - return Empty - -terminalParser :: Parser Expression -terminalParser = - do - choice - [ prefixParser, - parens expressionParser >>= \e -> return (Parens e), - listParser, - try booleanParser, - try emptyParser, - try decimalParser, - try variableParser, - integerParser - ] - --------------------------------------------- --- Expressions ----------------------------- --------------------------------------------- - -prefixParser :: Parser Expression -prefixParser = - do - op <- choice $ fmap (try . string . Text.pack) prefixOperators - _ <- spaceConsumer - ex <- expressionParser - _ <- spaceConsumer - return $ PrefixExp (Text.unpack op) ex - -eqParser :: Parser Expression -eqParser = - do - s <- sumParser - _ <- spaceConsumer - op <- observing (string "<=" <|> string "=" <|> string "<" <|> string ">" <|> string ">=") - _ <- spaceConsumer - case op of - Left _ -> return s - Right o -> eqParser >>= \ex -> return $ InfixExp (Text.unpack o) s ex - -sumParser :: Parser Expression -sumParser = - do - f <- factorParser - _ <- spaceConsumer - op <- observing (char '+' <|> char '-') - _ <- spaceConsumer - case op of - Left _ -> return f - Right o -> sumParser >>= \ex -> return $ reverseExpression $ InfixExp [o] f ex - -factorParser :: Parser Expression -factorParser = - do - p <- powerParser - _ <- spaceConsumer - op <- observing (char '*' <|> char '/') - _ <- spaceConsumer - case op of - Left _ -> return p - Right o -> factorParser >>= \ex -> return $ reverseExpression $ InfixExp [o] p ex - -powerParser :: Parser Expression -powerParser = - do - p <- postfixParser - _ <- spaceConsumer - op <- observing $ char '^' - _ <- spaceConsumer - case op of - Left _ -> return p - Right _ -> powerParser >>= \ex -> return $ InfixExp "^" p ex - -postfixParser :: Parser Expression -postfixParser = - do - t <- terminalParser - _ <- spaceConsumer - op <- observing (string "exists" <|> string "is absent" <|> string "count" <|> string "only-element") - _ <- spaceConsumer - case op of - Left _ -> return t - Right o -> return $ PostfixExp (Text.unpack o) t - --------------------------------------------- --- Auxiliary ------------------------------ --------------------------------------------- - -reverseExpression :: Expression -> Expression -reverseExpression (InfixExp op t1 (InfixExp op2 t2 e)) - | precedence op == precedence op2 = InfixExp op2 (reverseExpression (InfixExp op t1 t2)) e - | otherwise = InfixExp op t1 (InfixExp op2 t2 e) -reverseExpression e = e - -precedence :: String -> Int -precedence "or" = 1 -precedence "and" = 1 -precedence "+" = 2 -precedence "-" = 2 -precedence "*" = 3 -precedence "/" = 3 -precedence "^" = 4 -precedence _ = 100 - -prefixOperators :: [String] -prefixOperators = ["-", "not"] - -testArith3 = parseTest expressionParser "1 + (2 - 3)" -testArith4 = parseTest expressionParser "a * b - c * d - e * f = g * h - i * j - k * l" -testArith5 = parseTest expressionParser "a + b - c * d ^ e" -testArith6 = parseTest expressionParser "1 - 2 - 3 - 4 - 5 - 6" -testList = parseTest expressionParser "[1, 2, 3]" -testList2 = parseTest expressionParser "[1, 2 + 3, e]" -testFun = parseTest functionParser "Function()" -testFun2 = parseTest functionParser "Function(e)" -testFun3 = parseTest functionParser "Function(3, 3+2,e)" -testIf = parseTest expressionParser "if (Function(2 + 3, e)) then a + b - c * d ^ e -> x else not a exists" -testEverything = parseTest expressionParser "if [1, Function(3)] then 1 - 2 - 3 * a -> b ^ c" -testFail = parseTest expressionParser "if[1,as]thenxandoelseaora" \ No newline at end of file diff --git a/src/Parser/Expression.hs b/src/Parser/Expression.hs index ef44f0b..6cd918f 100644 --- a/src/Parser/Expression.hs +++ b/src/Parser/Expression.hs @@ -2,25 +2,112 @@ module Parser.Expression where +import Parser.General +import qualified Data.Text as Text import Text.Megaparsec import Text.Megaparsec.Char -import Model.Function -import Parser.General -import Data.Text - + +data Expression = Variable String + | Int String + | Real String + | Boolean String + | Empty + | Parens Expression + | List [Expression] + | Function String [Expression] + | PrefixExp String Expression + | PostfixExp String Expression + | InfixExp String Expression Expression + | IfSimple Expression Expression + | IfElse Expression Expression Expression + deriving (Show) + + +expressionParser :: Parser Expression +expressionParser = + choice [ ifParser, + try functionParser, + eqParser] + +-------------------------------------------- +-- Command Structures ---------------------- +-------------------------------------------- + +functionParser :: Parser Expression +functionParser = + do + f <- pascalNameParser + _ <- spaceConsumer + _ <- char '(' + ats <- many $ try (expressionParser >>= \ats -> spaceConsumer >> char ',' >> spaceConsumer >> return ats) + lat <- optional expressionParser + _ <- spaceConsumer + _ <- char ')' + _ <- spaceConsumer + case lat of + Nothing -> return $ Function f [] + Just at -> return $ Function f (ats ++ [at]) + +ifParser :: Parser Expression +ifParser = + do + _ <- string "if" + _ <- spaceConsumer + condition <- between (char '(') (char ')') expressionParser <|> expressionParser + _ <- spaceConsumer + _ <- string "then" + _ <- spaceConsumer + expr <- expressionParser + _ <- spaceConsumer + els <- observing $ string "else" + _ <- spaceConsumer + case els of + Left _ -> return (IfSimple condition expr) + Right _ -> expressionParser >>= \expr2 -> return (IfElse condition expr expr2) + +parens :: Parser a -> Parser a +parens = between (char '(') (char ')') + +-------------------------------------------- +-- Terminals ------------------------------- +-------------------------------------------- + +listParser :: Parser Expression +listParser = + do + _ <- char '[' + _ <- spaceConsumer + expressions <- many $ try (expressionParser >>= \ex -> spaceConsumer >> char ',' >> spaceConsumer >> return ex) + _ <- spaceConsumer + lastExpr <- try expressionParser + _ <- spaceConsumer + _ <- char ']' + _ <- spaceConsumer + return $ List (expressions ++ [lastExpr]) + variableParser :: Parser Expression variableParser = do var <- camelNameParser _ <- spaceConsumer - return $ Variable var - + inner <- many innerVariableParser + return $ Variable (var ++ concatMap ("->" ++) inner) + +innerVariableParser :: Parser String +innerVariableParser = + do + _ <- string "->" + _ <- spaceConsumer + var <- camelNameParser + _ <- spaceConsumer + return var + integerParser :: Parser Expression integerParser = do nr <- some digitChar _ <- spaceConsumer - return $ Literal $ show nr + return $ Int $ show nr decimalParser :: Parser Expression decimalParser = @@ -29,137 +116,136 @@ decimalParser = _ <- char '.' real <- many digitChar _ <- spaceConsumer - return $ Literal $ show nr ++ "." ++ real + return $ Real $ show nr ++ "." ++ real booleanParser :: Parser Expression booleanParser = do - bol <- string (pack "True") <|> string (pack "False") + bol <- string "True" <|> string "False" _ <- spaceConsumer - return $ Literal $ unpack bol - -listParser :: Parser Expression -listParser = - do - _ <- char '[' - _ <- spaceConsumer - expressions <- many $ try expressionList - _ <- spaceConsumer - lastExpr <- try expressionParser - _ <- spaceConsumer - _ <- char ']' - _ <- spaceConsumer - return $ ExpressionList (expressions ++ [lastExpr]) - where - expressionList = - do - expr <- expressionParser - _ <- spaceConsumer - _ <- char ',' - _ <- spaceConsumer - return expr + return $ Boolean $ Text.unpack bol emptyParser :: Parser Expression emptyParser = do _ <- string "empty" _ <- spaceConsumer - return $ Literal "empty" + return Empty -literalParser :: Parser Expression -literalParser = +terminalParser :: Parser Expression +terminalParser = do choice - [ booleanParser, + [ prefixParser, + parens expressionParser >>= \e -> return (Parens e), + listParser, + try booleanParser, try emptyParser, try decimalParser, try variableParser, integerParser ] - -parensParser :: Parser Expression -parensParser = - do - _ <- char '(' - expr <- expressionParser - _ <- char ')' - return expr -ifElseParser :: Parser Expression -ifElseParser = - do - (IfSimple cond expr) <- simpleIfParser - _ <- string "else" - _ <- spaceConsumer - expr2 <- expressionParser - _ <- spaceConsumer - return $ IfElse cond expr expr2 +-------------------------------------------- +-- Expressions ----------------------------- +-------------------------------------------- -simpleIfParser :: Parser Expression -simpleIfParser = +prefixParser :: Parser Expression +prefixParser = do - _ <- string "if" - _ <- spaceConsumer - condition <- expressionParser - _ <- spaceConsumer - _ <- string "then" - _ <- spaceConsumer - expr <- expressionParser - _ <- spaceConsumer - return $ IfSimple condition expr - -andParser :: Parser Expression -andParser = - do - (ex1, ex2) <- try $ binaryParser "and" - return $ And ex1 ex2 - -orParser :: Parser Expression -orParser = - do - (ex1, ex2) <- try $ binaryParser "or" - return $ Or ex1 ex2 - -subParser :: Parser Expression -subParser = - do - (ex1, ex2) <- try $ binaryParser "-" - return $ Subtract ex1 ex2 - -notParser :: Parser Expression -notParser = - do - _ <- string "not" + op <- choice $ fmap (try . string . Text.pack) prefixOperators _ <- spaceConsumer ex <- expressionParser _ <- spaceConsumer - return $ Not ex - -binaryParser :: String -> Parser (Expression, Expression) -binaryParser op = - do - ex1 <- literalParser - _ <- spaceConsumer - _ <- string $ pack op - _ <- spaceConsumer - ex2 <- expressionParser - _ <- spaceConsumer - return (ex1, ex2) - -expressionParser :: Parser Expression -expressionParser = choice - [parensParser, - notParser, - andParser, - orParser, - subParser, - ifElseParser, - simpleIfParser, - literalParser, - variableParser - ] + return $ PrefixExp (Text.unpack op) ex -testIfElse = parseTest expressionParser "if asd then 123 else 4" -testAnd = parseTest expressionParser "23 and 34 and 24 and a" -testOr = parseTest expressionParser "23 or 34 or 24 or a" -testMin = parseTest expressionParser "(a - b) - c" \ No newline at end of file +eqParser :: Parser Expression +eqParser = + do + s <- sumParser + _ <- spaceConsumer + op <- observing (string "<=" <|> string "=" <|> string "<" <|> string ">" <|> string ">=") + _ <- spaceConsumer + case op of + Left _ -> return s + Right o -> eqParser >>= \ex -> return $ InfixExp (Text.unpack o) s ex + +sumParser :: Parser Expression +sumParser = + do + f <- factorParser + _ <- spaceConsumer + op <- observing (char '+' <|> char '-') + _ <- spaceConsumer + case op of + Left _ -> return f + Right o -> sumParser >>= \ex -> return $ reverseExpression $ InfixExp [o] f ex + +factorParser :: Parser Expression +factorParser = + do + p <- powerParser + _ <- spaceConsumer + op <- observing (char '*' <|> char '/') + _ <- spaceConsumer + case op of + Left _ -> return p + Right o -> factorParser >>= \ex -> return $ reverseExpression $ InfixExp [o] p ex + +powerParser :: Parser Expression +powerParser = + do + p <- postfixParser + _ <- spaceConsumer + op <- observing $ char '^' + _ <- spaceConsumer + case op of + Left _ -> return p + Right _ -> powerParser >>= \ex -> return $ InfixExp "^" p ex + +postfixParser :: Parser Expression +postfixParser = + do + t <- terminalParser + _ <- spaceConsumer + op <- observing (string "exists" <|> string "is absent" <|> string "count" <|> string "only-element") + _ <- spaceConsumer + case op of + Left _ -> return t + Right o -> return $ PostfixExp (Text.unpack o) t + +-------------------------------------------- +-- Auxiliary ------------------------------ +-------------------------------------------- + +reverseExpression :: Expression -> Expression +reverseExpression (InfixExp op t1 (InfixExp op2 t2 e)) + | precedence op == precedence op2 = InfixExp op2 (reverseExpression (InfixExp op t1 t2)) e + | otherwise = InfixExp op t1 (InfixExp op2 t2 e) +reverseExpression e = e + +precedence :: String -> Int +precedence "or" = 1 +precedence "and" = 1 +precedence "+" = 2 +precedence "-" = 2 +precedence "*" = 3 +precedence "/" = 3 +precedence "^" = 4 +precedence _ = 100 + +prefixOperators :: [String] +prefixOperators = ["-", "not"] + +testArith3 = parseTest expressionParser "1 + (2 - 3)" +testArith4 = parseTest expressionParser "a * b - c * d - e * f = g * h - i * j - k * l" +testArith5 = parseTest expressionParser "a + b - c * d ^ e" +testArith6 = parseTest expressionParser "1 - 2 - 3 - 4 - 5 - 6" +testList = parseTest expressionParser "[1, 2, 3]" +testList2 = parseTest expressionParser "[1, 2 + 3, e]" +testFun = parseTest functionParser "Function()" +testFun2 = parseTest functionParser "Function(e)" +testFun3 = parseTest functionParser "Function(3, 3+2,e)" +testIf = parseTest expressionParser "if (Function(2 + 3, e)) then a + b - c * d ^ e -> x else not a exists" +testEverything = parseTest expressionParser "if [1, Function(3)] then 1 - 2 - 3 * a -> b ^ c" +testFail = parseTest expressionParser "if[1,as]thenxandoelseaora" \ No newline at end of file diff --git a/src/Parser/Function backup.hs b/src/Parser/Function backup.hs deleted file mode 100644 index 9f30cbe..0000000 --- a/src/Parser/Function backup.hs +++ /dev/null @@ -1,185 +0,0 @@ -module Parser.Function where - -import Model.Function -import Model.Type (TypeAttribute) -import Parser.Type (typeAttributeParser) -import Text.Megaparsec.Char -import Text.Megaparsec -import Parser.General -import Data.Text - -functionParser :: Parser Function -functionParser = - do - _ <- string $ pack "func" - _ <- spaceConsumer - fName <- pascalNameParser - _ <- char ':' - _ <- spaceConsumer - fDescription <- descriptionParser - fInput <- inputAttributesParser - fOutput <- outputAttributeParser - fConditions <- many (try postConditionParser <|> try conditionParser) - _ <- spaceConsumer - return (MakeFunction fName (Just fDescription) fInput fOutput fConditions) - -inputAttributesParser :: Parser [TypeAttribute] -inputAttributesParser = - do - _ <- string $ pack "inputs:" - _ <- spaceConsumer - inputs <- many $ try typeAttributeParser - _ <- spaceConsumer - return inputs - -outputAttributeParser :: Parser TypeAttribute -outputAttributeParser = - do - _ <- string $ pack "output:" - _ <- spaceConsumer - outputs <- typeAttributeParser - _ <- spaceConsumer - return outputs - ---parseTest conditionParser pack "condition: <\"Optional choice between directly passing a time or a timeType, which has to be resolved into a time based on the determination method.\"> if valuationTime exists then timeType is absent else if timeType exists then valuationTime is absent else False" - -conditionParser :: Parser Condition -conditionParser = - do - _ <- string $ pack "condition:" - _ <- spaceConsumer - description <- descriptionParser - (Expression statementString) <- lookAhead expressionParser - _ <- string $ pack statementString - rest <- getInput - _ <- setInput $ pack statementString - statement <- statementParser - _ <- setInput rest - _ <- spaceConsumer - return $ MakeCondition (Just description) statement ---parseTest postConditionParser (pack "post-condition: <\"The date and time must be properly resolved as attributes on the output.\"> observation -> date = ResolveAdjustableDate(valuationDate) and if valuationTime exists then observation -> time = TimeZoneFromBusinessCenterTime(valuationTime) else observation -> time = ResolveTimeZoneFromTimeType(timeType, determinationMethod)") - -postConditionParser :: Parser Condition -postConditionParser = - do - _ <- string $ pack "post-condition:" - _ <- spaceConsumer - description <- descriptionParser - (Expression statementString) <- lookAhead expressionParser - _ <- string $ pack statementString - rest <- getInput - _ <- setInput $ pack statementString - statement <- statementParser - _ <- setInput rest - _ <- spaceConsumer - return $ MakePostCondition (Just description) statement - -statementParser :: Parser Expression -statementParser = - do - statement <- - try ifElseParser <|> - try ifParser <|> - - try (binaryOpParser " and ") <|> - try (binaryOpParser " contains ") <|> - try (binaryOpParser " or ") <|> - try (binaryOpParser " = ") <|> - try (binaryOpParser " <> ") <|> - try (binaryOpParser " < ") <|> - try (binaryOpParser " <= ") <|> - try (binaryOpParser " >") <|> - try (binaryOpParser " >= ") <|> - - try (unaryOpParser " count") <|> - try (unaryOpParser " exists") <|> - try (unaryOpParser " is absent") <|> - - expressionParser - _ <- spaceConsumer - return statement - ---binaryOpParser :: String -> Parser Expression ---binaryOpParser op = --- do --- argument1String <- untilParser op --- rest <- getInput --- _ <- setInput $ pack argument1String --- argument1 <- statementParser --- _ <- setInput rest --- _ <- spaceConsumer --- argument2 <- statementParser --- _ <- spaceConsumer --- return $ BinaryOp (unpack $ strip $ pack op) argument1 argument2 --- ---unaryOpParser :: String -> Parser Expression ---unaryOpParser op = --- do --- statementString <- untilParser op --- rest <- getInput --- _ <- setInput $ pack statementString --- statement <- statementParser --- _ <- setInput rest --- _ <- spaceConsumer --- return $ UnaryOp (unpack $ strip $ pack op) statement --- ---ifParser :: Parser Expression ---ifParser = --- do --- _ <- string $ pack "if" --- _ <- spaceConsumer --- cond <- statementParser --- _ <- spaceConsumer --- _ <- string $ pack "then" --- expr <- statementParser --- _ <- spaceConsumer --- return $ IfSimple cond expr - ---ifParser :: Parser Expression ---ifParser = --- do --- _ <- string $ pack "if" --- _ <- spaceConsumer --- conditionString <- untilParser "then" --- rest <- getInput --- _ <- setInput $ pack conditionString --- condition <- statementParser --- _ <- setInput rest --- _ <- spaceConsumer --- stmt <- statementParser --- return $ If condition stmt - ---ifElseParser :: Parser Expression ---ifElseParser = --- do --- _ <- string $ pack "if" --- _ <- spaceConsumer --- conditionString <- untilParser "then" --- rest <- getInput --- _ <- setInput $ pack conditionString --- condition <- statementParser --- _ <- setInput rest --- _ <- spaceConsumer --- thenString <- untilParser "else" --- rest1 <- getInput --- _ <- setInput $ pack thenString --- thenExpression <- statementParser --- _ <- setInput rest1 --- _ <- spaceConsumer --- elseExpression <- statementParser --- return $ IfElse condition thenExpression elseExpression - ---parseTest expressionParser (pack "alalala condition:") - -expressionParser :: Parser Expression -expressionParser = - do - statement <- - untilParser "post-condition:" <|> - untilParser "condition:" <|> - untilParser "func" <|> - untilParser "enum" <|> - untilParser "type" <|> - try (anySingle `manyTill` eof) - _ <- spaceConsumer - return $ Expression $ unpack (strip $ pack statement) \ No newline at end of file