module Parser where

import Monpar
import Control.Applicative ((<|>), Alternative, many, some)
import Data.Char (isDigit, digitToInt)
import Control.Monad (MonadPlus(mzero), void) 

type ZorthAST = [ZorthExpr]

data ZorthExpr = ZorthASTInteger Int
               | ZorthASTWord String
               | ZorthASTWordDecl (String,ZorthAST)
               | ZorthASTIfElse (ZorthAST,ZorthAST)
               | ZorthASTWhile (ZorthAST,ZorthAST)
               deriving Show

word1 :: Parser String
word1 = do
    x <- sat (\x -> x /= '\n' && x /= ' ')
    xs <- word
    return $ x:xs

nonsenseSymbol :: Parser Char 
nonsenseSymbol = char ' ' <|> char '\n'

skipNonsenseSymbols :: Parser [Char] 
skipNonsenseSymbols = many nonsenseSymbol 

digit :: Parser Int
digit = digitToInt <$> sat isDigit 

pZorthUnsignedInteger :: Parser ZorthExpr
pZorthUnsignedInteger = ZorthASTInteger .  foldr (\n t -> n + t*10) 0 . reverse <$> some digit

pZorthSignedInteger :: Parser ZorthExpr
pZorthSignedInteger = do
    char '-'
    (ZorthASTInteger i) <- pZorthUnsignedInteger
    return $ ZorthASTInteger $ negate i

pZorthInteger :: Parser ZorthExpr
pZorthInteger = do
    skipNonsenseSymbols
    i <- pZorthSignedInteger <|> pZorthUnsignedInteger 
    return i

pZorthWord :: Parser ZorthExpr
pZorthWord = do
    skipNonsenseSymbols
    ZorthASTWord <$> word1

pZorthWordDecl :: Parser ZorthExpr
pZorthWordDecl = do
    ZorthASTWord ":" <- pZorthWord
    ZorthASTWord name <- pZorthWord
    xs <- manyTill pZorthExpr (do { ZorthASTWord ";" <- pZorthWord; return () })
    return $ ZorthASTWordDecl (name,xs)


pZorthIfElse :: Parser ZorthExpr
pZorthIfElse = do
    ZorthASTWord "if" <- pZorthWord
    ifBranch <- manyTill pZorthExpr (do { ZorthASTWord "else" <- pZorthWord; return () })
    elseBranch <- manyTill pZorthExpr (do { ZorthASTWord "fi" <- pZorthWord; return () })
    return $ ZorthASTIfElse (ifBranch,elseBranch)

pZorthWhile :: Parser ZorthExpr
pZorthWhile = do
    ZorthASTWord "begin" <- pZorthWord
    condition <- manyTill pZorthExpr (do { ZorthASTWord "while" <- pZorthWord; return () })
    body <- manyTill pZorthExpr (do { ZorthASTWord "repeat" <- pZorthWord; return () })
    return $ ZorthASTWhile (condition,body)

pZorthExpr :: Parser ZorthExpr
pZorthExpr = pZorthWhile <|> pZorthIfElse <|> pZorthWordDecl <++ pZorthInteger <++ pZorthWord

pZorth :: Parser ZorthAST 
pZorth = some pZorthExpr 

parseZorth :: String -> ZorthAST
parseZorth = fst . head . runParser pZorth