Hace unos días me he topado con el problema de devolver algo que no sea tipo IO (a)
en el resultado final de mi parser, esto me ha llevado a buscar y preguntar por algunos sitios, pero nada.Al final, lambdaman me recomendo mirar la implementación de la función parseIO (y también me explico varias partes del código) de la libreria UU.Parsing y el resultado es que ahora tengo un parseA que me devuleve lo que estaba buscando. Ahora lo describo paso a paso.

PROBLEMA :
1. Devolver la suma de las hojas de un arbol binario
2. Devolver la suma de las hojas de otro arbol binario
3. Sumar ambos resultados cuyo tipo sea Int.

El problema 1 y 2 son sencillos, consiste en solo mostrar la suma de las hojas de los arboles (implementando un simple scanner, parser y su ag), pero hasta ahora no me habia dado cuenta que el resultado final de nuestros parsers por lo general tienden a ser algún tipo de monada como IO () o IO (a) por lo que siempre usamos la funcion parseIO de UU.Parsing.

El conflicto esta en el problema 3. Como hago para no entrar en el uso de monadas y poder sumar ambos resultados y al final devolver un tipo Int que representa el resultado de ambas sumas?.

SOLUCION :
La solución esta en estudiar y modificar la función parseIO de la libreria UU.Parsing.

En el Modulo UU.Parsing se construye la funcion parseIO.Las personas que en algún momento usamos parseIO, sabemos que recibe 2 argumentos el primero es un parser y el segundo la cadena de entrada o una lista de tokens

parseIO esta construido en base a la función parseIOMessage, por lo que deducimos que quien hace gran parte del trabajo es parseIOMessage.

parseIO :: (Eq s, Show s, Symbol s) => Parser s a -> [s] -> IO a
parseIO = parseIOMessage showMessage
where showMessage (Msg expecting position action)
= let pos = case position of
Nothing -> "at end of file"
Just s -> case action of
Insert _ -> "before " ++ show s
Delete t -> "at " ++ show t
in "\n?? Error : " ++ pos ++
"\n?? Expecting : " ++ show expecting ++
"\n?? Repaired by: " ++ show action ++ "\n"

Por otro lado, en el modulo UU.Parsing.Interface encontramos la funcion parseIOMessage donde hay 2 funciones interesantes :
- evalStepsIO. que se encarga de la decodificación de la salida de ejecución del parser en terminos de IO
- parse, es la función que realiza el proceso de parsing propiamente dicho. Devuelve una
estructura de Steps.

parseIOMessage :: ( Symbol s, InputState inp s p)
=> (Message s p -> String)
-> AnaParser inp Pair s p a
-> inp
-> IO a
parseIOMessage showMessage p inp
= do (Pair v final) <- evalStepsIO showMessage (parse p inp)
final `seq` return v -- in order to force the trailing error
messages to
be printed

parse :: (Symbol s, InputState inp s pos)
=> AnaParser inp Pair s pos a
-> inp
-> Steps (Pair a (Pair inp ())) s pos
parse = parsebasic handleEof


Se podría deducir que la función evalStepsIO es la encargada de convertir toda la entrada que pasa por parse a algun tipo IO a .Entonces si la deducción fuera correcta podríamos modificar la función evalStepsIO para que devuelva un tipo a, en vez de un tipo IO a, eso en términos de implementación solo consiste en quitarle todo lo que se parezca a una monada como las instrucciones do, return:

Así, la función evalStepsIO que originalmente es de esta forma:
evalStepsIO :: (Message s p -> String)
-> Steps b s p
-> IO b
evalStepsIO showMessage = evalStepsIO' showMessage (-1)

evalStepsIO' :: (Message s p -> String)
-> Int
-> Steps b s p
-> IO b
evalStepsIO' showMessage n (steps :: Steps b s p) = eval n steps
where eval :: Int -> Steps a s p -> IO a
eval 0 steps = return (evalSteps steps)
eval n steps = case steps of
OkVal v rest -> do arg <- unsafeInterleaveIO (eval n rest)
return (v arg)
Ok rest -> eval n rest
Cost _ rest -> eval n rest
StRepair _ msg rest -> do hPutStr stderr (showMessage msg)
eval (n-1) rest
Best _ rest _ -> eval n rest
NoMoreSteps v -> return v

cambia a esta forma :

evalStepsA :: (Message s p -> String)
-> Steps b s p
-> b
evalStepsA showMessage = evalStepsA' showMessage (-1)

evalStepsA' :: (Message s p -> String)
-> Int
-> Steps b s p
-> b

evalStepsA' showMessage n (steps :: Steps b s p) = eval n steps
where eval :: Int -> Steps a s p -> a
eval 0 steps = (evalSteps steps)
eval n steps = case steps of
OkVal v rest -> v (eval n rest) -- unsafeInterleaveIO
Ok rest -> eval n rest
Cost _ rest -> eval n rest
StRepair _ msg rest -> eval (n-1) rest -- do hPutStr stderr (showMessage msg)
Best _ rest _ -> eval n rest
NoMoreSteps v -> v


De igual forma la función parseIOMessage, quitamos todo lo que implica el uso de monadas y cambiamos el nombre a parseAMessage de esta forma :

parseIOMessage :: ( Symbol s, InputState inp s p)
=> (Message s p -> String)
-> AnaParser inp Pair s p a
-> inp
-> IO a
parseIOMessage showMessage p inp
= do (Pair v final) <- evalStepsIO showMessage (parse p inp)
final `seq` return v -- in order to force the trailing error messages to be printed

cambia a :

parseAMessage :: ( Symbol s, InputState inp s p)
=> (Message s p -> String)
-> AnaParser inp Pair s p a
-> inp
-> a
parseAMessage showMessage p inp
= par (evalStepsA showMessage (parse p inp))

par (Pair v final) = final `seq` v


Finalmente la función parseIO es modificada y como ahora muestra un tipo a, se llama parseA

parseA :: (Eq s, Show s, Symbol s) => Parser s a -> [s] -> a
parseA = parseAMessage showMessage
where showMessage (Msg expecting position action)
= let pos = case position of
Nothing -> "at end of file"
Just s -> case action of
Insert _ -> "before " ++ show s
Delete t -> "at " ++ show t
in "\n?? Error : " ++ pos ++
"\n?? Expecting : " ++ show expecting ++
"\n?? Repaired by: " ++ show action ++ "\n"


Ahora simplemente guardamos este código en un modulo llamado ParseA y esta listo para usarlo.
En el problema 3 descrito al principio de este post lo que podemos hacer es construir una funcion que reciba el parser de nuestro arbol binario llamado pRoot y usando la nueva función parseA obtenemos un resultado Int a cambio de obtener IO Int

getSum :: String -> Int
getSum es_arb = parseA pRoot (classify es_arb)

classify ... -- hace el trabajo del scanner

Ahora es simplemente llamar a cuantos arboles binarios se quiera y con getSum obtengo un tipo primitivo Int al que puedo aplicar la funcion suma (+) cuantas veces quiera, sin tener que preocuparme por el manejo de monadas.Veamos un ejemplo :

getSum "(5)(5)" -> 10
getSum "((9)(7))((3)(2))" -> 21

getSum "(5)(5)" + getSum "((9)(7))((3)(2))" -> 31

En el archivo adjunto esta todo el código implementado tanto de parseA como de un ejemplo completo.Puede que el ejemplo de sumar árboles binarios no sea tan útil para muchos, pero parseA se acomoda a cualquier tipo A, es decir, puede ser un tipo primitivo Int, String, Float, Char, etc. y lo mas seguro es que tambien devuelve un tipo definido por uno mismo. Pero no lo he probado parat todos los casos, asi que si alguien encuentra un errorcillo o le hace una mejora, serial genial.