{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}
{-# LANGUAGE FlexibleContexts #-}
{-|
Module      : Silver.Compiler.Lexer
Description : The lexer using parser combinators for silver.
Copyright   : (c) Nicholas Dujay, 2016
License     : MIT
Maintainer  : nickdujay@gmail.com
Stability   : experimental
Portability : POSIX
-}
module Silver.Compiler.Lexer where

import Debug.Trace

import Data.Char
import Text.Megaparsec
import Text.Megaparsec.Text

import qualified Data.Text as T
import qualified Text.Megaparsec.Lexer as L
import qualified Text.Megaparsec.Char as C

-- space characters
void p = p >> return ()

blockComment :: Parser ()
blockComment = L.skipBlockComment "{-" "-}"

lineComment :: Parser ()
lineComment = L.skipLineComment "--"

spaces :: Parser ()
spaces = void (char ' ' <|> tab)

sc :: Parser ()
sc = L.space spaces lineComment blockComment

scn :: Parser ()
scn = L.space (void spaceChar) lineComment blockComment

-- lexeme
lexeme = L.lexeme sc
symbol = L.symbol sc

-- reserved words
rws :: [String]
rws = ["if", "then", "else", "data", "type"]

-- identifiers
identifier = (lexeme . try) (p >>= check)
  where
    p = (:) <$> identStart <*> identLetters
    check x = if x `elem` rws
                then fail $ "reserved word " ++ show x ++ "cannot be an identifier"
                else return x

identStart :: Parser Char
identStart = letterChar <|> markChar

identLetters :: Parser String
identLetters = many (alphaNumChar <|> markChar <|> symbolChar <|> char '\'')

moduleId :: Parser String
moduleId = lexeme $ many letterChar

-- utils
parens = between (symbol "(") (symbol ")")
withParens p = (\s -> \s2 -> \s3 -> s ++ s2 ++ s3) <$> symbol "(" <*> p <*> symbol ")"
braces = between (symbol "{") (symbol "}")
brackets = between (symbol "[") (symbol "]")
comma = symbol ","

-- primitives
primChar :: Parser Char
primChar = lexeme $ char '\'' *> L.charLiteral <* char '\''

primString :: Parser String
primString = lexeme $ char '"' >> manyTill L.charLiteral (char '"')

primInteger :: Parser Integer
primInteger = L.signed sc L.integer

primFloat :: Parser Double
primFloat = L.signed sc L.float
