[Haskell-cafe] Parsers are monadic?

[Claus Reinke]

> When you pretend you've never heard of monads or arrows, and 
> write down the types what do you get?

this question made me wonder whether i could still recall how i used 
to write parsers before i heard of monads or arrows. it is difficult not 
to fall back into the pattern of state transformer monads, but -just for fun- 
here's an quick approximation of double-continuation-based parser 
combinators, where each parser takes a success and a failure continuation. 

the success continuation takes a parse result and the remaining text, 
the failure continuation takes the remaining text. the basic combinators 
are 'litP predicate' (parsing a literal/character), '.>' (sequence of two 
parsers), '.|' (alternative of two parsers), '.:' and '..:' (process and 
combine parse results before passing them to the success continuation). 
'?>' ignores its first result, '#>' pairs its two results (i'm sure i didn't use 
as many cute combinators at the time:-).

[ to those of you writing debuggers for haskell: 
  this kind of functional programming -programming with functions- 
  could be a good stress test for your tool ]

claus

------------------------------------------------
import Data.Char

infixr .>,.|,?>,#>

type Parser a t = (a->String->t) -> (String->t) -> (String->t)

empty    s f = \cs-> s () cs
eot      s f = \cs-> case cs of { "" -> s '\EOT' ""; '\EOT':_ -> s '\EOT' ""; _ -> f cs } 
litP p   s f = \cs-> case cs of { c:cs' | p c -> s c cs'; _ -> f cs }
but x    s f = \cs-> x (\_ _->f cs) (\_->s undefined cs) cs

(a ?> b) s f = \cs->a (\ar->b s (\_->f cs)) f cs
(a #> b) s f = \cs->a (\ar->b (s . ((,)ar)) (\_->f cs)) f cs
(a .> b) s f = \cs->a (\ar->b (s ar) (\_->f cs)) f cs
(a .| b) s f = a s (b s f)

(parse  .: build) s f = parse (s . build) f
(parse ..: build) s f = parse ((s .) . build) f

parse p = ((p .> eot) ..: const) (const . Right) Left

many p = (( p .> many p ) ..: (:) ) .| ( p .: return )

digit  = litP isDigit .: digitToInt
digits = many digit
num    = digits .: (foldl ((+) . (10*)) 0)

space    = litP isSpace
anyChar  = litP (const True)
nonSpace = ( but space ?> anyChar ) 
sep      = litP (==':')
field    = ( many nonSpace #> many space ?> sep ?> many space ?> many nonSpace ) 
nonField = but field ?> many anyChar