module Parser(parseProgram, parseExpression) where

import Control.Monad
import Data.Char
import Text.Parsec

import AST


type Parser = Parsec String ()


parseProgram :: String -> Either ParseError Program
parseProgram = parse pProgram ""

pProgram :: Parser Program
pProgram = between pWhiteComment eof (liftM Program (many pValue))


parseExpression :: String -> Either ParseError Value
parseExpression = parse pExpression ""

pExpression :: Parser Value
pExpression = between pWhiteComment eof pValue


pValue :: Parser Value
pValue = pVEllipsis <|> pVList <|> pVNum <|> pVString <|> pVName <|> pVQuoted  <?> "value"

pVList :: Parser Value
pVList = flip label "list" $ do
    symbol "("
    exs <- many pValue
    symbol ")"
    return $ VList exs

pVNum :: Parser Value
pVNum = liftM (VNum . read) (many1 digit) <* pWhiteComment  <?> "number"

pVString :: Parser Value
pVString = flip label "string" $ do
    void $ char '"'
    s <- manyTill anyChar (symbol "\"")
    return $ VString s

pVName :: Parser Value
pVName = flip label "name" $ do
    first <- satisfy isFirstNameChar
    rest <- many (satisfy isNameChar)
    pWhiteComment
    return $ VName $ first : rest
  where
    isNameChar c = ((c >= '*' && c <= 'z') || c `elem` "!#$%&|~") && c /= ';'
    isFirstNameChar c = isNameChar c && not (isDigit c)

pVQuoted :: Parser Value
pVQuoted = char '\'' >> liftM VQuoted pValue  <?> "quoted value"

pVEllipsis :: Parser Value
pVEllipsis = symbol "..." >> return VEllipsis  <?> "ellipsis"


symbol :: String -> Parser ()
symbol s = try (string s) >> pWhiteComment

pWhiteComment :: Parser ()
pWhiteComment = do
    pWhitespace
    void $ many $ pComment >> pWhitespace
  where
    pWhitespace :: Parser ()
    pWhitespace = void (many space)  <?> "whitespace"

    pComment :: Parser ()
    pComment = flip label "comment" $ do
        void $ char ';'
        void (manyTill anyChar (void endOfLine <|> eof))