From d54ba6f112ab8a7f13eca14fb3f1465235a246e8 Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Fri, 26 Sep 2008 09:54:09 +0000
Subject: [PATCH] bnf and ebnf printer: align ::= symbols.

---
 src/GF/Speech/CFG.hs | 11 +++++++++--
 src/GF/Speech/SRG.hs |  4 ++--
 2 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/src/GF/Speech/CFG.hs b/src/GF/Speech/CFG.hs
index b8857a288..8e6c520d6 100644
--- a/src/GF/Speech/CFG.hs
+++ b/src/GF/Speech/CFG.hs
@@ -273,11 +273,18 @@ countRules :: CFG -> Int
 countRules = length . allRules
 
 prCFG :: CFG -> String
-prCFG = unlines . map prRule . allRules
+prCFG = prProductions . map prRule . allRules
     where 
-      prRule r = lhsCat r ++ " ::= " ++ unwords (map prSym (ruleRhs r))
+      prRule r = (lhsCat r, unwords (map prSym (ruleRhs r)))
       prSym = symbol id (\t -> "\""++ t ++"\"")
 
+prProductions :: [(Cat,String)] -> String
+prProductions prods = 
+    unlines [rpad maxLHSWidth lhs ++ " ::= " ++ rhs | (lhs,rhs) <- prods]
+    where
+      maxLHSWidth = maximum $ 0:(map (length . fst) prods)
+      rpad n s = s ++ replicate (n - length s) ' '
+
 --
 -- * CFRule Utilities
 --
diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs
index 08f732055..3bf431eb1 100644
--- a/src/GF/Speech/SRG.hs
+++ b/src/GF/Speech/SRG.hs
@@ -175,9 +175,9 @@ ungroupTokens = joinRE . mapRE (symbol (RESymbol . NonTerminal) (REConcat . map
 --
 
 prSRG :: SRG -> String
-prSRG = unlines . map prRule . srgRules
+prSRG = prProductions . map prRule . srgRules
     where 
-      prRule (SRGRule c alts) = c ++ " ::= " ++ unwords (intersperse "|" (map prAlt alts))
+      prRule (SRGRule c alts) = (c,unwords (intersperse "|" (map prAlt alts)))
       prAlt (SRGAlt _ _ rhs) = prRE prSym rhs
       prSym = symbol fst (\t -> "\""++ t ++"\"")