{-# LANGUAGE NoMonomorphismRestriction #-}
module Ubc.Parse.Syntax.Language
( languageDef
, typeName
, Ubc.Parse.Syntax.Language.identifier         
, Ubc.Parse.Syntax.Language.reserved           
, Ubc.Parse.Syntax.Language.operator           
, Ubc.Parse.Syntax.Language.reservedOperator   
, Ubc.Parse.Syntax.Language.characterLiteral   
, Ubc.Parse.Syntax.Language.stringLiteral      
, Ubc.Parse.Syntax.Language.natural            
, Ubc.Parse.Syntax.Language.integer            
, Ubc.Parse.Syntax.Language.float              
, Ubc.Parse.Syntax.Language.naturalOrFloat     
, Ubc.Parse.Syntax.Language.decimal            
, Ubc.Parse.Syntax.Language.hexadecimal        
, Ubc.Parse.Syntax.Language.octal              
, Ubc.Parse.Syntax.Language.symbol             
, Ubc.Parse.Syntax.Language.lexeme             
, Ubc.Parse.Syntax.Language.whiteSpace         
, Ubc.Parse.Syntax.Language.parens             
, Ubc.Parse.Syntax.Language.braces             
, Ubc.Parse.Syntax.Language.angles             
, Ubc.Parse.Syntax.Language.brackets           
, Ubc.Parse.Syntax.Language.semicolon          
, Ubc.Parse.Syntax.Language.comma              
, Ubc.Parse.Syntax.Language.colon              
, Ubc.Parse.Syntax.Language.dot                
, Ubc.Parse.Syntax.Language.semicolonSeparated 
, Ubc.Parse.Syntax.Language.semicolonSeparated1
, Ubc.Parse.Syntax.Language.commaSeparated     
, Ubc.Parse.Syntax.Language.commaSeparated1    
)
where

import Data.Functor ( ($>) )
import Text.Parsec
    ( alphaNum, char, letter, oneOf, choice, (<|>), ParsecT )
import Text.Parsec.Token
    ( makeTokenParser,
      GenLanguageDef(..),
      GenTokenParser(TokenParser, identifier, reserved, operator,
                     reservedOp, charLiteral, stringLiteral, natural, integer, float,
                     naturalOrFloat, decimal, hexadecimal, octal, symbol, lexeme,
                     whiteSpace, parens, braces, angles, brackets, semi, comma, colon,
                     dot, semiSep, semiSep1, commaSep, commaSep1) )

languageDef :: Monad m => GenLanguageDef String u m
languageDef = LanguageDef {
          commentStart = "/*"
        , commentEnd = "*/"
        , commentLine = "//"
        , nestedComments = True
        , identStart = letter <|> char '_'
        , identLetter = alphaNum <|> char '_'
        , opStart = oneOf "+-*/%"
        , opLetter = oneOf "+-*/%"
        , reservedNames = [ "struct", "u32", "i32", "f32", "if", "then", "else" ]
        , reservedOpNames = [ "+", "-", "*", "/", "%" ]
        , caseSensitive = True
        }

tokenParser :: Monad m => GenTokenParser String u m
tokenParser = makeTokenParser languageDef

identifier              :: Monad m => ParsecT String u m String
reserved                :: Monad m => String -> ParsecT String u m ()
operator                :: Monad m => ParsecT String u m String
reservedOperator        :: Monad m => String -> ParsecT String u m ()
characterLiteral        :: Monad m => ParsecT String u m Char
stringLiteral           :: Monad m => ParsecT String u m String
natural                 :: Monad m => ParsecT String u m Integer
integer                 :: Monad m => ParsecT String u m Integer
float                   :: Monad m => ParsecT String u m Double
naturalOrFloat          :: Monad m => ParsecT String u m (Either Integer Double)
decimal                 :: Monad m => ParsecT String u m Integer
hexadecimal             :: Monad m => ParsecT String u m Integer
octal                   :: Monad m => ParsecT String u m Integer
symbol                  :: Monad m => String -> ParsecT String u m String
lexeme                  :: Monad m => ParsecT String u m a -> ParsecT String u m a
whiteSpace              :: Monad m => ParsecT String u m ()
parens                  :: Monad m => ParsecT String u m a -> ParsecT String u m a
braces                  :: Monad m => ParsecT String u m a -> ParsecT String u m a
angles                  :: Monad m => ParsecT String u m a -> ParsecT String u m a
brackets                :: Monad m => ParsecT String u m a -> ParsecT String u m a
semicolon               :: Monad m => ParsecT String u m String
comma                   :: Monad m => ParsecT String u m String
colon                   :: Monad m => ParsecT String u m String
dot                     :: Monad m => ParsecT String u m String
semicolonSeparated      :: Monad m => ParsecT String u m a -> ParsecT String u m [a]
semicolonSeparated1     :: Monad m => ParsecT String u m a -> ParsecT String u m [a]
commaSeparated          :: Monad m => ParsecT String u m a -> ParsecT String u m [a]
commaSeparated1         :: Monad m => ParsecT String u m a -> ParsecT String u m [a]
TokenParser{
          identifier            = identifier
        , reserved              = reserved
        , operator              = operator
        , reservedOp            = reservedOperator
        , charLiteral           = characterLiteral
        , stringLiteral         = stringLiteral
        , natural               = natural -- decimal, hexadecimal or octal
        , integer               = integer -- decimal, hexadecimal or octal
        , float                 = float
        , naturalOrFloat        = naturalOrFloat
        , decimal               = decimal
        , hexadecimal           = hexadecimal
        , octal                 = octal
        , symbol                = symbol
        , lexeme                = lexeme
        , whiteSpace            = whiteSpace
        , parens                = parens
        , braces                = braces
        , angles                = angles
        , brackets              = brackets
        , semi                  = semicolon
        , comma                 = comma
        , colon                 = colon
        , dot                   = dot
        , semiSep               = semicolonSeparated
        , semiSep1              = semicolonSeparated1
        , commaSep              = commaSeparated
        , commaSep1             = commaSeparated1
        } = tokenParser

typeName :: Monad m => ParsecT String u m String
typeName = choice
        [ Ubc.Parse.Syntax.Language.reserved "i32" $> "i32"
        , Ubc.Parse.Syntax.Language.reserved "u32" $> "u32"
        , Ubc.Parse.Syntax.Language.reserved "f32" $> "f32"
        , Ubc.Parse.Syntax.Language.identifier
        ]