showsPrec: cui bono?

[C.Reinke]

> has anybody here used in a non-trivial way the showsPrec anti-parser?

Isn't the idea to make things trivial while avoiding performance
penalties? Perhaps: simple pretty-printing of abstract syntax trees?

I often use it to get simple debugging output for complex internal
data structures (first, use deriving; then, define showsPrec; if
that's still not good enough, do some real thinking..).

Anyway, this reminded me of a litte old hack of mine.  Only trivial
use of showsPrec, but perhaps you'll like it anyway?-)

http://www.cs.ukc.ac.uk/people/staff/cr3/toolbox/haskell/R.hs

As with anything else in my toolbox, no warranty for nothing..

Cheers,
Claus

------------------- cut here

{-
  Representative thingies..

  A little hack to pair values with string representations
  of their expressions. Useful if you want to explain what

    map (+1) [1..4] or foldr1 (*) [1..5]

  do, or if you want to demonstrate the difference between 

    foldr (+) 0 [1..4] and foldl (+) 0 [1..4]

  Load this module into Hugs (Hugs mode) and type in some of 
  these examples to get an idea of what I mean. Also try

    map (+) [1..4]
  
  This could be extended in various directions, but I wanted to 
  keep things simple. I'm not convinced that extra complications 
  would be worth the effort.

  Claus Reinke
-}

default (R Integer)

data R a = R {rep:: String
             ,val:: a
             }

instance Show (R a) where
  showsPrec _ a = showString (rep a)

instance Show (R a -> R b) where
  showsPrec _ f = showString ("\\x->"++(rep (f x)))
    where
      x = R{rep="x",val=error "variable"}

instance Show (R a -> R b -> R c) where
  showsPrec _ f = showString ("\\x y->"++(rep (f x y)))
    where
      x = R{rep="x",val=error "variable"}
      y = R{rep="y",val=error "variable"}

lift1 op a = R {rep="("++(rep op)++" "++(rep a)++")"
               ,val= (   (val op)       (val a)   )
               }

lift2 op a b  = R {rep="("++(rep op)++" "++(rep a)++" "++(rep b)++")"
                  ,val= (   (val op)       (val a)       (val b)   )
                  }

lift2infix op a b  = R {rep="("++(rep a)++" "++(rep op)++" "++(rep b)++")"
                       ,val= (   (val a)          `iop`       (val b)   )
                       }
                       where
                        iop = val op

instance (Num a,Show a) => Num (R a) where
  (+)    = lift2infix R{rep="+",val=(+)}
  (-)    = lift2infix R{rep="-",val=(-)}
  (*)    = lift2infix R{rep="*",val=(*)}
  negate = lift1 R{rep="-",val=negate}
  fromInteger a = (\fIa->R{rep=show fIa,val=fIa}) (fromInteger a)

instance (Eq a,Num a) => Eq (R a) where
  a == b = (val a) == (val b)

instance (Ord a,Num a) => Ord (R a) where
  a <= b = (val a) <= (val b)

instance (Enum a,Num a,Show a) => Enum (R a) where
  fromEnum   = fromEnum.val
  toEnum   a = R{rep=show a,val=toEnum a}
  enumFrom x = map toEnum [fromEnum x..] -- missing in Hugs Prelude..