[Haskell-cafe] A very nontrivial parser [Source code]

[Claus Reinke]

source code is always useful, as it is concrete. but some comments about
purpose and important aspects would help, too, lest we optimise away the
parts you're most interested in. as it stands, i must assume that 'decodeRLEb' 
is the purpose of the exercise, and it isn't clear to me why that requires 
nested or otherwise nontrivial parsers?

on lists, it could be coded as a straightforward recursion, but i assume 
that abstraction over sources, and decomposition of the main function 
into repeatedly applied parsers is part of the specification, too. still, 
what's wrong with plain parsing? as has been discussed in previous
threads here, (>>=) as a monadic parser combinator would even allow 
you to compute the second parser from the output of the first parser, 
should you need that flexibility. but in this particular case, there are just 
three alternative branches, consuming 2,3, or 1 numbers from the source.

btw, MonadPlus and 'fail _ = mzero' allow for handling of alternatives
and parse or match failure without lots of ifs getting in the way. the same
approach also avoids the separate 'empty' test in Source.

claus

-----------------------------------------------------code follows
{-# OPTIONS_GHC -fglasgow-exts #-}
{-# OPTIONS_GHC -fno-monomorphism-restriction #-}
import Data.List 
import Control.Monad
import Control.Monad.State

encodeRLE = concatMap work . group
  where work [0]                  = [0,0]
        work xs@(x:_) | x==0      = [0,l,0]
                      | l>2       = [0,l,x]
                      | otherwise = xs
                      where l = length xs - 1

type DataStream = [Int]
type Parser m a = StateT DataStream m a

class    Source c  where fetch :: Monad m => c a -> m (a,c a)
instance Source [] where fetch xs = do { x:xs' <- return xs; return (x,xs') }

decodeRLE :: Parser Maybe DataStream
decodeRLE = (oneGroup >++ decodeRLE) `mplus` (return [])
  where
  oneGroup = encoded `mplus` elem
  a >++ b  = do { as <- a; bs <- b; return (as++bs) }

  encoded  = zero >> (zero `mplus` nx)
  nx       = do { [n]<-elem; [x]<-elem; return (replicate (n+1) x) }
  elem     = StateT $ \nxs-> do { (x,nxs') <- fetch nxs; return ([x],nxs') }
  zero     = StateT $ \nxs-> do { (0,nxs') <- fetch nxs; return ([0],nxs') }

x :: DataStream
x = map (read . return) "034444220005555500"

test = x==x'
  where Just x' = evalStateT decodeRLE (encodeRLE x)