ppr x = pprRules x;


pprRules []     = nil;
pprRules (r:rs) = nil <> pRules r rs <> nil; 

pRules r' []     = pprRule r';
pRules r' (r:rs) = pprRule r' <> nil <> text ";" <> line' <> pRules r rs;


pprRule (Rule f ps e) =
  group (var f <> space <> pprPats ps <> space' <> text "=" 
         <> nest 4 (line' <> pprExp e));
  

pprPats [] = text "";
pprPats (p:ps) = pPats p ps ;

pPats p' []     = pprPat p';
pPats p' (p:ps) = pprPat p' <> space <> pPats p ps;


pprPat p = manyParens (pprPat_ p);

pprPat_ (PVar x)    = var x;
pprPat_ (PCon c []) = con c;
pprPat_ (PCon c (p:ps)) = parens (con c <> space <> pPats p ps);

pprExp e = go 4 e; 

go i e = manyParens (go_ i e);
go_ i (ECon c []) = con c ;
go_ i (ECon c (e:es)) = parensIf (i >= 9) (con c <> space <> pExps e es);
go_ i (EOp OAlt e1 e2) = parensIf (i >= 5) $ group $ 
    go 5 e1 <> nest 2 (line' <> text "<+" <> space' <> go 4 e2);
go_ i (EOp OCat e1 e2) = parensIf (i >= 6) $ group $ 
    go 6 e1 <> nest 2 (line' <> text "<>" <> space' <> go 5 e2);
go_ i (EVar f []) = var f;  
go_ i (EVar f (e:es)) = parensIf (i >= 9) (var f <> space <> pExps e es);

pExps e' []     = go 9 e';
pExps e' (e:es) = go 9 e' <> space <> pExps e es;
  

var f = text (f @@ re "[a-z_][_a-zA-Z0-9]*'*");
con c = text (c @@ re "[A-Z][_a-zA-Z0-9]*'*");


parensIf b d = if b then parens d else d ;
manyParens d = d <+ parens (manyParens d);

parens d = text "(" <> nest 1 (nil <> d <> nil) <> text ")";
space = (text " " <+ charOf (spaceChars `butnot` char ' ')) <> nil;
nil = text "" <+ (charOf spaceChars <> nil);

line' = line <+ text "" ; 
space' = space <+ text "";
