module Language.Elna.Parser
    ( Parser
    , programP
    ) where

import Control.Monad (void)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Void (Void)
import Language.Elna.AST
    ( Declaration(..)
    , Identifier(..)
    , Parameter(..)
    , Program(..)
    , TypeExpression(..)
    , VariableDeclaration(..)
    )
import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy)
import Text.Megaparsec.Char (alphaNumChar, letterChar, space1)
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Control.Applicative (Alternative(..))
import Data.Maybe (isJust)

type Parser = Parsec Void Text

space :: Parser ()
space = Lexer.space space1 (Lexer.skipLineComment "//")
    $ Lexer.skipBlockComment "/*" "*/"

lexeme :: forall a. Parser a -> Parser a
lexeme = Lexer.lexeme space

symbol :: Text -> Parser Text
symbol = Lexer.symbol space

blockP :: forall a. Parser a -> Parser a
blockP = between (symbol "{") (symbol "}")

procedureP :: Parser ()
procedureP = void $ symbol "proc"

parensP :: forall a. Parser a -> Parser a
parensP = between (symbol "(")  (symbol ")")

openBracketP :: Parser ()
openBracketP = void $ symbol "["

closingBracketP :: Parser ()
closingBracketP = void $ symbol "]"

colonP :: Parser ()
colonP = void $ symbol ":"

semicolonP :: Parser ()
semicolonP = void $ symbol ";"

identifierP :: Parser Identifier
identifierP =
    let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
     in fmap Identifier $ lexeme $ Text.pack <$> wordParser

typeExpressionP :: Parser TypeExpression
typeExpressionP = arrayTypeExpression
    <|> NamedType <$> identifierP
    <?> "type expression"
  where
    arrayTypeExpression = flip ArrayType
        <$> (symbol "array" *> openBracketP *> lexeme Lexer.decimal <* closingBracketP)
        <*> (symbol "of" *> typeExpressionP)

typeDefinitionP :: Parser Declaration
typeDefinitionP = TypeDefinition
    <$> (symbol "type" *> identifierP)
    <*> (symbol "=" *> typeExpressionP)
    <?> "type definition"

variableDeclarationP :: Parser VariableDeclaration
variableDeclarationP = VariableDeclaration
    <$> (symbol "var" *> identifierP)
    <*> (colonP *> typeExpressionP)
    <* semicolonP
    <?> "variable declaration"

parameterP :: Parser Parameter
parameterP = paramCons
    <$> optional (symbol "ref")
    <*> identifierP
    <*> (colonP *> typeExpressionP)
  where
    paramCons ref name typeName = Parameter name typeName (isJust ref)

parametersP :: Parser [Parameter]
parametersP = parensP $ sepBy parameterP (symbol ",")

procedureDefinitionP :: Parser Declaration
procedureDefinitionP = ProcedureDefinition
    <$> (procedureP *> identifierP)
    <*> parametersP
    <*> blockP (many variableDeclarationP)
    <*> pure mempty -- TODO
    <?> "procedure definition"

declarationP :: Parser Declaration
declarationP = typeDefinitionP <|> procedureDefinitionP

programP :: Parser Program
programP = Program <$> many declarationP