refactored to add lexemes

RosettaParser.cabal

@@ -28,9 +28,7 @@ library
       Model.Enum
       Model.Function
       Model.Type
-      Parser.Expression
       Parser.Enum
-      Parser.Expr
       Parser.Expression
       Parser.Function
       Parser.General

src/Model/Function.hs

@@ -16,45 +16,24 @@ data Condition =
     MakeCondition {
         conditionDescription :: Maybe String,
         conditionStatement :: Expression
---        conditionStatement :: String
     }
     | MakePostCondition {
         conditionDescription :: Maybe String,
         conditionStatement :: Expression
---        conditionStatement :: String
     }
     deriving (Show)
      
-data Expression = --String deriving (Show)
-    Variable String
-    | Literal String
-    | ExpressionList [Expression]
-    | InnerType Expression Expression
-    
-    | Or Expression Expression
-    | And Expression Expression
-    | Not Expression
-    
-    | Exists Expression
-    | IsAbsent Expression
-    | Contains Expression Expression
-    | Disjoint Expression Expression
-    | Count Expression
-    | OnlyExists Expression
-    | OnlyElement Expression
-    
-    | Equals Expression Expression
-    | Different Expression Expression
-    | GreaterStrict Expression Expression
-    | SmallerStrict Expression Expression
-    | GreaterOrEqual Expression Expression
-    | SmallerOrEqual Expression Expression
-    
-    | Sum Expression Expression
-    | Subtract Expression Expression
-    | Product Expression Expression
-    | Division Expression Expression
-    
+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)

src/Parser/Enum.hs

@@ -14,41 +14,30 @@ enumParser =
         eName <- enumNameParser
         eDescription <- descriptionParser
         values <- many enumValueParser
-        _ <- spaceConsumer
         return (MakeEnum eName (Just eDescription) values)
 
 --parseTest enumValueParser "D displayName \"day\" <\"Day\">"        
 enumValueParser :: Parser EnumValue
 enumValueParser = 
     do
-        vName <- enumValueNameParser
+        vName <- nameParser
         dName <- enumValueDisplayNameParser
         vDescription <- descriptionParser
         return (MakeEnumValue vName (Just vDescription) (Just dName))
 
-enumValueNameParser :: Parser String
-enumValueNameParser = 
-    do
-        name <- nameParser
-        _ <- spaceConsumer
-        return name
-
 enumValueDisplayNameParser :: Parser String
 enumValueDisplayNameParser =
     do
-        _ <- string "displayName \""
-        name <- anySingle `manyTill` char '"'
-        _ <- spaceConsumer
-        return name
+        _ <- lexeme $ string "displayName"
+        _ <- char '"'
+        lexeme $ anySingle `manyTill` char '"'
 
 enumNameParser :: Parser String
 enumNameParser = 
     do
-        _ <- string "enum"
-        _ <- spaceConsumer
+        _ <- lexeme $ string "enum"
         name <- nameParser
-        _ <- char ':'
-        _ <- spaceConsumer
+        _ <- lexeme $ char ':'
         return name 
 
 periodEnum :: EnumType

src/Parser/Expr.hs

@@ -1,3 +0,0 @@
-module Parser.Expr where
-
-import Parser.General

src/Parser/Expression.hs

@@ -3,47 +3,29 @@
 module Parser.Expression where
 
 import Parser.General
+import Model.Function
 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,
+    try functionCallParser,
     eqParser]
 
 --------------------------------------------
 -- Command Structures ----------------------
 --------------------------------------------
 
-functionParser :: Parser Expression
-functionParser =
+functionCallParser :: Parser Expression
+functionCallParser =
     do
-        f <- pascalNameParser
-        _ <- spaceConsumer
-        _ <- char '('
-        ats <- many $ try (expressionParser >>= \ats -> spaceConsumer >> char ',' >> spaceConsumer >> return ats)
-        lat <- optional expressionParser
-        _ <- spaceConsumer
-        _ <- char ')'
-        _ <- spaceConsumer
+        f <- lexeme pascalNameParser
+        _ <- lexeme $ char '('
+        ats <- many $ try (expressionParser >>= \ats -> lexeme $ char ',' >> return ats)
+        lat <- optional $ lexeme expressionParser
+        _ <- lexeme $ char ')'
         case lat of
             Nothing -> return $ Function f []
             Just at -> return $ Function f (ats ++ [at])
@@ -51,16 +33,11 @@ functionParser =
 ifParser :: Parser Expression
 ifParser =
     do
-        _ <- string "if"
-        _ <- spaceConsumer
-        condition <- between (char '(') (char ')') expressionParser <|> expressionParser
-        _ <- spaceConsumer
-        _ <- string "then"
-        _ <- spaceConsumer
+        _ <- lexeme $ string "if"
+        condition <- lexeme $ between (char '(') (char ')') expressionParser <|> expressionParser
+        _ <- lexeme $ string "then"
         expr <- expressionParser
-        _ <- spaceConsumer
-        els <- observing $ string "else"
-        _ <- spaceConsumer
+        els <- observing $ lexeme $ string "else"
         case els of
             Left _ -> return (IfSimple condition expr)
             Right _ -> expressionParser >>= \expr2 -> return (IfElse condition expr expr2)
@@ -75,38 +52,29 @@ parens = between (char '(') (char ')')
 listParser :: Parser Expression
 listParser =
     do
-        _ <- char '['
-        _ <- spaceConsumer
-        expressions <- many $ try (expressionParser >>= \ex -> spaceConsumer >> char ',' >> spaceConsumer >> return ex)
-        _ <- spaceConsumer
+        _ <- lexeme $ char '['
+        expressions <- many $ try (expressionParser >>= \ex -> lexeme $ char ',' >> return ex)
         lastExpr <- try expressionParser
-        _ <- spaceConsumer
-        _ <- char ']'
-        _ <- spaceConsumer
+        _ <- lexeme $ char ']'
         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
+        _ <- lexeme $ string "->"
+        camelNameParser
 
 integerParser :: Parser Expression
 integerParser =
     do
-        nr <- some digitChar
-        _ <- spaceConsumer
+        nr <- lexeme $ some digitChar
         return $ Int $ show nr
         
 decimalParser :: Parser Expression
@@ -114,22 +82,19 @@ decimalParser =
     do
         nr <- some digitChar
         _ <- char '.'
-        real <- many digitChar
-        _ <- spaceConsumer
+        real <- lexeme $ many digitChar
         return $ Real $ show nr ++ "." ++ real
         
 booleanParser :: Parser Expression
 booleanParser =
     do
-        bol <- string "True" <|> string "False"
-        _ <- spaceConsumer
+        bol <- lexeme (string "True" <|> string "False")
         return $ Boolean $ Text.unpack bol
 
 emptyParser :: Parser Expression
 emptyParser = 
     do
-        _ <- string "empty"
-        _ <- spaceConsumer
+        _ <- lexeme $ string "empty"
         return Empty
 
 terminalParser :: Parser Expression
@@ -153,19 +118,14 @@ terminalParser =
 prefixParser :: Parser Expression
 prefixParser = 
     do
-        op <- choice $ fmap (try . string . Text.pack) prefixOperators
-        _ <- spaceConsumer
-        ex <- expressionParser
-        _ <- spaceConsumer
-        return $ PrefixExp (Text.unpack op) ex
+        op <- lexeme $ choice $ fmap (try . string . Text.pack) prefixOperators
+        PrefixExp (Text.unpack op) <$> expressionParser
 
 eqParser :: Parser Expression
 eqParser =
     do
         s <- sumParser
-        _ <- spaceConsumer
-        op <- observing (string  "<=" <|> string "=" <|> string "<" <|> string ">" <|> string ">=")
-        _ <- spaceConsumer
+        op <- lexeme $ observing (string  "<=" <|> string "=" <|> string "<" <|> string ">" <|> string ">=")
         case op of
             Left _ -> return s
             Right o -> eqParser >>= \ex -> return $ InfixExp (Text.unpack o) s ex
@@ -174,9 +134,7 @@ sumParser :: Parser Expression
 sumParser =
     do
         f <- factorParser
-        _ <- spaceConsumer
-        op <- observing (char '+' <|> char '-')
-        _ <- spaceConsumer
+        op <- lexeme $ observing (char '+' <|> char '-')
         case op of
             Left _ -> return f
             Right o -> sumParser >>= \ex -> return $ reverseExpression $ InfixExp [o] f ex
@@ -185,9 +143,7 @@ factorParser :: Parser Expression
 factorParser = 
     do 
         p <- powerParser
-        _ <- spaceConsumer
-        op <- observing (char '*' <|> char '/')
-        _ <- spaceConsumer
+        op <- lexeme $ observing (char '*' <|> char '/')
         case op of
             Left _ -> return p
             Right o -> factorParser >>= \ex -> return $ reverseExpression $ InfixExp [o] p ex
@@ -196,9 +152,7 @@ powerParser :: Parser Expression
 powerParser = 
     do
         p <- postfixParser
-        _ <- spaceConsumer
-        op <- observing $ char '^'
-        _ <- spaceConsumer
+        op <- lexeme $ observing $ char '^'
         case op of
             Left _ -> return p
             Right _ -> powerParser >>= \ex -> return $ InfixExp "^" p ex
@@ -207,9 +161,7 @@ postfixParser :: Parser Expression
 postfixParser = 
     do
         t <- terminalParser
-        _ <- spaceConsumer
-        op <- observing (string "exists" <|> string "is absent" <|> string "count" <|> string "only-element")
-        _ <- spaceConsumer
+        op <- lexeme $ observing (string "exists" <|> string "is absent" <|> string "count" <|> string "only-element")
         case op of
             Left _ -> return t
             Right o -> return $ PostfixExp (Text.unpack o) t
@@ -243,9 +195,9 @@ 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)"
+testFun = parseTest functionCallParser "Function()"
+testFun2 = parseTest functionCallParser "Function(e)"
+testFun3 = parseTest functionCallParser "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"

src/Parser/Function.hs

@@ -13,58 +13,42 @@ import Parser.General
 functionParser :: Parser Function
 functionParser =
     do
-        _ <- string "func"
-        _ <- spaceConsumer
+        _ <- lexeme $ string "func"
         fName <- pascalNameParser
-        _ <- char ':'
-        _ <- spaceConsumer
+        _ <- lexeme $ char ':'
         fDescription <- descriptionParser
         fInput <- inputAttributesParser
         fOutput <- outputAttributeParser
         fAssignments <- many assignmentParser
-        _ <- spaceConsumer
         return (MakeFunction fName (Just fDescription) fInput fOutput fAssignments)
 
 assignmentParser :: Parser (Expression, Expression)
 assignmentParser =
     do
-        _ <- string "assign-output"
-        _ <- spaceConsumer
+        _ <- lexeme $ string "assign-output"
         name <- expressionParser
-        _ <- spaceConsumer
-        _ <- char ':'
-        _ <- spaceConsumer
+        _ <- lexeme $ char ':'
         expr <- expressionParser
-        _ <- spaceConsumer
         return (name, expr)
 
 inputAttributesParser :: Parser [TypeAttribute]
 inputAttributesParser =
     do
-        _ <- string "inputs:"
-        _ <- spaceConsumer
-        inputs <- many $ try attributeParser
-        _ <- spaceConsumer
-        return inputs
+        _ <- lexeme $ string "inputs:"
+        many $ try attributeParser
 
 outputAttributeParser :: Parser TypeAttribute
 outputAttributeParser =
     do
-        _ <- string "output:"
-        _ <- spaceConsumer
-        outputs <- attributeParser
-        _ <- spaceConsumer
-        return outputs
+        _ <- lexeme $ string "output:"
+        attributeParser
         
 attributeParser :: Parser TypeAttribute
 attributeParser =
     do
         nam <- camelNameParser 
-        _ <- spaceConsumer
         typ <- pascalNameParser <|> camelNameParser
-        _ <- spaceConsumer
         crd <- cardinalityParser
-        _ <- spaceConsumer
         desc <- optional descriptionParser
         return $ MakeTypeAttribute nam typ crd desc
         

src/Parser/General.hs

@@ -13,41 +13,33 @@ type Parser = Parsec Void Text
 spaceConsumer :: Parser ()
 spaceConsumer = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/")
 
-symbol :: Text -> Parser Text
-symbol = L.symbol spaceConsumer
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme spaceConsumer
 
 descriptionParser :: Parser String
 descriptionParser = 
     do
         _ <- string "<\""
-        description <- anySingle `manyTill` string "\">"
-        _ <- spaceConsumer
-        return description
+        lexeme $ anySingle `manyTill` string "\">"
         
 
 pascalNameParser :: Parser String
 pascalNameParser =
     do
         first <- upperChar
-        rest <- many (letterChar <|> digitChar <|> char '_')
-        _ <- spaceConsumer
+        rest <- lexeme $ many (letterChar <|> digitChar <|> char '_')
         return (first : rest)
 
 camelNameParser :: Parser String
 camelNameParser =
     do
         first <- lowerChar
-        rest <- many (letterChar <|> digitChar <|> char '_')
-        _ <- spaceConsumer
+        rest <- lexeme $ many (letterChar <|> digitChar <|> char '_')
         return (first : rest)
 
 nameParser :: Parser String
 nameParser = 
     do 
         first <- letterChar <|> char '_'
-        rest <- many (letterChar <|> digitChar <|> char '_')
-        _ <- spaceConsumer
+        rest <- lexeme $ many (letterChar <|> digitChar <|> char '_')
         return (first:rest)
-        
-untilParser :: String -> Parser String
-untilParser x = try (anySingle `manyTill` string (pack x))

src/Parser/Type.hs

@@ -13,83 +13,56 @@ typeParser =
     do 
         tName <- typeNameParser
         tDescription <- descriptionParser
-        tAttributes <- many $ try typeAttributeParserWDesc <|> try typeAttributeParser
-        _ <- spaceConsumer
+        tAttributes <- many $ try typeAttributeParser
         return (MakeType tName (Just tDescription) tAttributes)
 
-typeAttributeParserWDesc :: Parser TypeAttribute
-typeAttributeParserWDesc = 
-    do
-        (MakeTypeAttribute aName aType card Nothing) <- typeAttributeParser
-        descriptionParser >>= \aDescription -> return (MakeTypeAttribute aName aType card (Just aDescription))
-
 typeAttributeParser :: Parser TypeAttribute
 typeAttributeParser = 
     do
-        aName <- attributeNameParser
+        aName <- camelNameParser
         aType <- nameParser
-        _ <- spaceConsumer
         card <- cardinalityParser
-        _ <- spaceConsumer
-        return (MakeTypeAttribute aName aType card Nothing)
+        desc <- optional descriptionParser
+        return (MakeTypeAttribute aName aType card desc)
 
 cardinalityParser :: Parser Cardinality
 cardinalityParser =
     do
-        card <- parseExactlyOne <|> parseOneOrMore <|> parseZeroOrMore <|> parseZeroOrOne
-        _ <- spaceConsumer
-        return card
+        parseExactlyOne <|> parseOneOrMore <|> parseZeroOrMore <|> parseZeroOrOne
 
 parseOneOrMore :: Parser Cardinality
 parseOneOrMore = 
     do
-        _ <- string "(1..*)"
+        _ <- lexeme $ string "(1..*)"
         return OneOrMore
 
 
 parseExactlyOne :: Parser Cardinality
 parseExactlyOne = 
     do
-        _ <- string "(1..1)"
+        _ <- lexeme $ string "(1..1)"
         return ExactlyOne
         
         
 parseZeroOrMore :: Parser Cardinality
 parseZeroOrMore = 
     do
-        _ <- string "(0..*)"
+        _ <- lexeme $ string "(0..*)"
         return ZeroOrMore
         
         
 parseZeroOrOne :: Parser Cardinality
 parseZeroOrOne = 
     do
-        _ <- string "(0..1)"
+        _ <- lexeme $ string "(0..1)"
         return ZeroOrOne
 
-attributeNameParser :: Parser String
-attributeNameParser = 
-    do
-        name <- camelNameParser
-        _ <- spaceConsumer
-        return name
-
-enumValueDisplayNameParser :: Parser String
-enumValueDisplayNameParser =
-    do
-        _ <- string "displayName \""
-        name <- anySingle `manyTill` char '"'
-        _ <- spaceConsumer
-        return name
-
 typeNameParser :: Parser String
 typeNameParser = 
     do
-        _ <- string "type"
-        _ <- spaceConsumer
+        _ <- lexeme $ string "type"
         name <- pascalNameParser
-        _ <- char ':'
-        _ <- spaceConsumer
+        _ <- lexeme $ char ':'
         return name 
 
 periodType :: Type