module Parser (readExpr) where

import Monad
import Text.ParserCombinators.Parsec hiding (spaces)

import Value

symbol :: Parser Char
symbol = oneOf "!$%&|*+-/:<=?>@^_~#"

spaces :: Parser ()
spaces = skipMany1 space

parseString :: Parser LispVal
parseString = do
    char '"'
    x <- many (noneOf "\"")
    char '"'
    return (String x)

parseAtom :: Parser LispVal
parseAtom = do
    first <- letter <|> symbol
    rest <- many (letter <|> digit <|> symbol)
    let atom = first : rest
    return $ case atom of
        "#t" -> Bool True
        "#f" -> Bool False
        _ -> Atom atom

parseNumber :: Parser LispVal
parseNumber = liftM (Number . read) (many1 digit)

parseQuoted :: Parser LispVal
parseQuoted = do
    char '\''
    x <- parseExpr
    return $ List [Atom "quote", x]

parseList :: Parser LispVal
parseList = liftM List $ sepBy parseExpr spaces

parseDottedList :: Parser LispVal
parseDottedList = do
    head <- endBy parseExpr spaces
    tail <- char '.' >> spaces >> parseExpr
    return $ DottedList head tail

parseExpr :: Parser LispVal
parseExpr = parseString
        <|> parseAtom
        <|> parseNumber
        <|> parseQuoted
        <|> do
            char '('
            x <- (try parseList) <|> parseDottedList
            char ')'
            return x

parseOneExpr :: Parser LispVal
parseOneExpr = do
    x <- parseExpr
    eof
    return x

readOneExpr :: String -> Either String LispVal
readOneExpr input =
    case parse parseOneExpr "lisp" input of
        -- Left err -> fail $ "Parse error: " ++ show err
        -- Left err -> Bool False
        Left err -> Left $ "Parse error: " ++ show err
        Right val -> Right val

readExpr :: String -> Either String LispVal
readExpr input =
    case parse parseExpr "lisp" input of
        Left err -> Left $ "Parse error: " ++ show err
        Right val -> Right val