haskell-chat/Lobby

module Main where

import System.IO
import Control.Monad
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as Token
--import qualified Text.Parsec.Token as P

data BExpr = BoolConst Bool
| Not BExpr
| BBinary BBinOp BExpr BExpr
| RBinary RBinOp AExpr AExpr
deriving (Show)

data BBinOp = And | Or deriving (Show)

data RBinOp = Greater | Less deriving (Show)

data AExpr = Var String
| IntConst Integer
| Neg AExpr
| ABinary ABinOp AExpr AExpr
deriving (Show)

data DataType = Int Integer
| Double Integer
| Void String
| Char Char
deriving(Show)

data ABinOp = Add
| Subtract
| Multiply
| Divide
deriving (Show)

data Stmt = Seq [Stmt]
| Assign String AExpr
| If BExpr Stmt Stmt
| While BExpr Stmt
| Skip
deriving (Show)

lenguageDef = emptyDef {
Token.commentStart = "/"
, Token.commentEnd = "/"
, Token.commentLine = "//"
, Token.identStart = letter
, Token.identLetter = alphaNum
, Token.reservedNames = [ "if"
--, "then"
, "else"
, "while"
, "do"
, "skip"
, "true"
, "false"
, "not"
, "and"
, "or"
, "void"
, "int"
, "char"
, "double"
]
, Token.reservedOpNames = ["+", "-", "*", "/", ":="
, "<", ">", "and", "or", "not"
]
}

lexer = Token.makeTokenParser lenguageDef

identifier = Token.identifier lexer -- parses an identifier
reserved = Token.reserved lexer -- parses a reserved name
reservedOp = Token.reservedOp lexer -- parses an operator
parens = Token.parens lexer -- parses surrounding parenthesis:
-- parens p
-- takes care of the parenthesis and
-- uses p to parse what's inside them
braces = Token.braces lexer
integer = Token.integer lexer -- parses an integer
semi = Token.semi lexer -- parses a semicolon
whiteSpace = Token.whiteSpace lexer -- parses whitespace

whileParser :: Parser Stmt
whileParser = whiteSpace >> statement

statement :: Parser Stmt
statement = parens statement
<|> sequenceOfStmt

sequenceOfStmt =
do list <- (sepBy1 statement' semi)
-- If there's only one statement return it without using Seq.
return $ if length list == 1 then head list else Seq list

statement' :: Parser Stmt
statement' = ifStmt
<|> whileStmt
<|> skipStmt
<|> assignStmt

ifStmt :: Parser Stmt
ifStmt =
do reserved "if"
cond <- bExpression
reserved "else"
stmt1 <- statement
return $ If cond stmt1 stmt1
whileStmt :: Parser Stmt
whileStmt =
do reserved "while"
cond <- bExpression
reserved "do"
stmt <- statement
return $ While cond stmt

assignStmt :: Parser Stmt
assignStmt =
do var <- identifier
reservedOp "="
expr <- aExpression
return $ Assign var expr

skipStmt :: Parser Stmt
skipStmt = reserved "skip" >> return Skip

aExpression :: Parser AExpr
aExpression = buildExpressionParser aOperators aTerm

bExpression :: Parser BEx