module Parser where

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

type ZorthAST = [ZorthExpr]

data ZorthExpr = ZorthASTInteger Int
               | ZorthASTWord String
               | ZorthASTWordDecl (String,ZorthAST)
               | ZorthASTIfElse (ZorthAST,ZorthAST)
               | ZorthASTWhile (ZorthAST,ZorthAST)
               | ZorthASTComment String
               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 = skipNonsenseSymbols >> pZorthSignedInteger <|> pZorthUnsignedInteger 

pZorthWord :: Parser ZorthExpr
pZorthWord = do
    _ <- skipNonsenseSymbols
    w <- word1
    eof <|> void nonsenseSymbol
    return $ ZorthASTWord w 

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)

pZorthComment :: Parser ZorthExpr
pZorthComment = do
    ZorthASTWord "(" <- pZorthWord
    body <- manyTill get (do { ZorthASTWord ")" <- pZorthWord; return () })
    return $ ZorthASTComment body

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

pZorth :: Parser ZorthAST 
pZorth = some pZorthExpr 

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