module Parser (
    char
  , string
  , digit
  , letter
  , many
  , many1
  , parse
  , (<|>)
  , anyChar
  , Parser
)

 where


import Data.Char
import Control.Applicative hiding (many)

newtype Parser a = Parser (String -> [(a, String)])

instance Monad Parser where
    p >>= g = Parser (\input -> case parse p input of
                                    []    -> []
                                    [(v, input')] -> parse (g v) input')

instance Applicative Parser where
    pure v = Parser (\input -> [(v,input)])
    pg <*> px = Parser (\input -> case parse pg input of
                                     [] -> []
                                     [(g, out)] -> parse (fmap g px) out)


instance Functor Parser where
    fmap f p = Parser (\input -> case parse p input of
                                    [] -> []
                                    [(v,out)] -> [(f v, out)])

instance Alternative Parser where
  empty = Parser (\_ -> [])
  p <|> q = Parser (\input -> case parse p input of
                                 []        -> parse q input
                                 [(v,out)] -> [(v,out)])



-- Failure
failure :: Parser a
failure = Parser (\_ -> [])

-- Parser Application
parse :: Parser a -> String -> [(a, String)]
parse (Parser p) input = p input

-- Parsers
item :: Parser Char
item = Parser (\input -> case input of
                             [] -> []
                             (x:xs) -> [(x, xs)])

-- Recebe um predicado e o usa para validar um caractere obtido pelo parser item
sat :: (Char -> Bool) -> Parser Char
sat p = item >>= \x ->
    if p x then return x else failure

-- Um parser que valida se um char é o informado
char :: Char -> Parser Char
char x = sat (== x)

-- Usa o parser char e recursividade para parsear strings
string :: String -> Parser String
string [] = return []
string (x:xs) = do
    char x
    string xs
    return (x:xs)

digit :: Parser Char
digit = sat isDigit

letter :: Parser Char
letter = sat isLetter

anyChar :: Parser Char
anyChar = item

many :: Parser a -> Parser [a]
many p = many1 p <|> return []

many1 :: Parser a -> Parser [a]
many1 p = do
    v  <- p
    vs <- many p

    return (v:vs)

module Main where

import Parser

testData1 = "(abcdefgh)"
testData2 = "(asd(bcd)efg)"
testData3 = "asd(asd(bcd)efg)ghe"

testData4 = "asd(asd(bcd)efg)ghe)"
testData5 = "(asd(asd(bcd)efg)ghe"
testData6 = "(asd(a(sd(bcd)efg)ghe))"

test1 = evaluate dataString testData1
test2 = evaluate dataString testData2
test3 = evaluate dataString testData3
test4 = evaluate dataString testData4
test5 = evaluate dataString testData5
test6 = evaluate dataString testData6

tests = do
    putStrLn (testData1 ++ "\t\t=>\t" ++ test1)
    putStrLn (testData2 ++ "\t\t=>\t" ++ test2)
    putStrLn (testData3 ++ "\t=>\t"   ++ test3)
    putStrLn (testData4 ++ "\t=>\t"   ++ test4)
    putStrLn (testData5 ++ "\t=>\t"   ++ test5)
    putStrLn (testData6 ++ "\t=>\t"   ++ test6)

    return ()

evaluate :: Parser String -> String -> String
evaluate p input = case parse p input of
                       [(v, [])] -> "Balanceado"
                       [(_, out)] -> "Nao balanceado"
                       [] -> error "Erro no parsing"

dataString :: Parser String
dataString = do
    c  <- values <|> block

    return c

block :: Parser String
block = do
    char '('
    v <- values
    char ')'

    return v

values :: Parser String
values = do
    v1 <- many (letter <|> digit)
    (do {
        b  <- block;
        v2 <- values;
        return (v1 ++ b ++ v2);
    }) <|> return v1