import Control.Monad
import GHC.Base hiding ((<|>))
import Data.Char hiding (isDigit)

---------------------------------------------------

-- | Parser type 

newtype Parser a = P {runP :: String -> [(a,String)]}

instance Functor Parser where
  fmap f p = P $ \cs -> [(f a,cs') | (a,cs') <- runP p cs]

instance Applicative Parser where
  pure a =  P (\cs -> [(a,cs)])
  -- (<*>) ::  Parser (a -> b) -> Parser a -> Parser b
  (P p) <*> (P q) = P $ \cs -> [ (f a, cs'')  |  (f , cs')   <- p cs
                                              ,  (a , cs'')  <- q cs']

instance Monad Parser where
  return a    = P $ \cs -> [(a,cs)]
  (P p) >>= f = P $ \cs -> concat [runP (f a) cs' | (a,cs') <- p cs]

-- | Parsers primitivos

pFail :: Parser a
pFail = P $ \cs -> []

(<|>) :: Parser a -> Parser a -> Parser a
(P p) <|> (P q) = P $ \cs -> case p cs ++ q cs of
                              []     -> []
                              (x:xs) -> [x]

item :: Parser Char
item = P $ \cs -> case cs of
                    ""     -> []
                    (c:cs) -> [(c,cs)]

pSat :: (Char -> Bool) -> Parser Char
pSat p = do c <- item
            if p c then return c
                   else pFail

pSym :: Char -> Parser Char
pSym c = pSat (== c)

-- | reconocer un digito

isDigit c = (c >= '0') && (c <= '9')

digit :: Parser Int
digit = do c <- pSat isDigit
           return (ord c - ord '0')

-- | recursion
-- | cero o mas veces p

pList :: Parser a -> Parser [a]
pList p = do a <- p
             as <- pList p
             return (a:as)
          <|>
          return []

-- | una o mas veces p

pList1 :: Parser a -> Parser [a]
pList1 p = do a <- p
              as <- pList p
              return (a:as)

-- | parsear una lista de digitos

-- | si no hay ningun digito se devuelve la lista vacia

digits :: Parser [Int]
digits = pList digit

-- | cuando se espera que haya al menos un digito

digits1 :: Parser [Int]
digits1 = pList1 digit

-- | sumar la lista de digitos

sumDigits :: Parser Int
sumDigits = do ds <- digits
               return (sum ds)

divby3 :: Parser Bool
divby3 = do n <- sumDigits
            return (n `mod` 3 == 0)

-- | reconocer un numero
-- | reconoce una lista de digitos y retorna el entero que denota
-- | se retorna cero si no hay ningun digito

number :: Parser Int
number = number' 0

-- se utiliza Horner
number' :: Int -> Parser Int
number' n = do d <- digit
               number' (n*10 + d)
            <|>
            return n

-- de forma equivalente 

num = do ds <- digits
         return (foldl op 0 ds)
  where
    n `op` d = n*10 + d

-- | fallar si no hay digitos

num1 = do ds <- digits1
          return (foldl op 0 ds)
  where
    n `op` d = n*10 + d

-- otra forma

number1 = do d <- digit
             number' d      

-- | reconocer una expresion 

data Exp = Num Int | Add Exp Exp
     deriving Show

-- version que entra en loop (recursion a la izquierda)

badexp :: Parser Exp
badexp  = do e1 <- badexp
             pSym '+'
             e2 <- badexp
             return (Add e1 e2)
          <|>
          do n <- number
             return (Num n)

-- version correcta

expression  :: Parser Exp
expression  =  do n <- num1
                  pSym '+'
                  e <- expression
                  return (Add (Num n) e)
               <|>
               do n <- num1
                  return (Num n)

-- | parsing y evaluacion

evalExp = do e <- expression
             return (eval e)

eval (Num n) = n
eval (Add e e') = eval e + eval e'

-- | version fusionada

evalExp_fus  :: Parser Int
evalExp_fus  = do n <- num1
                  pSym '+'
                  e <- evalExp_fus
                  return (n + e)
                 <|>
                 num1  

-- | expresiones con parentesis

expression_par :: Parser Exp
expression_par = do e1 <- sumando
                    pSym '+'
                    e2 <- expression_par
                    return (Add e1 e2)
                 <|> 
                 sumando
               
sumando :: Parser Exp
sumando = do pSym '('
             e <- expression_par 
             pSym ')'
             return e
             <|>
             do n <- num1
                return (Num n)             

evalExpr_par = do e <- expression_par
                  return (eval e)

-- | nano XML

data Xml = Tag Char [Xml]
         | Text String
 deriving Show 

parserXML :: Parser Xml
parserXML = do pSym '<'
               name <- item
               pSym '>'
               xmls <- pList parserXML
               pSym '<'
               pSym '/'
               -- utiliza el resultado de un parser anterior
               pSym name  
               pSym '>'
               return $ Tag name xmls
            <|>   
            do t <- text
               return $ Text t 
             
text :: Parser String
text = pList1 (pSat p)
  where p c = isAlphaNum c || isSpace c         

xml = "<A><B>Ejemplo de XML</B><C>con</C><D>3 campos</D></A>"