From 5264780e67d74eb16a4cb499072b89b57ca4a37c Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Fri, 23 Feb 2007 16:28:06 +0000
Subject: [PATCH] cc -table

---
 src/GF/API.hs                 | 21 +++++++++++++++++++++
 src/GF/Shell.hs               |  3 ++-
 src/GF/Shell/HelpFile.hs      |  1 +
 src/GF/Shell/ShellCommands.hs |  2 +-
 src/HelpFile                  |  1 +
 5 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/src/GF/API.hs b/src/GF/API.hs
index 9eb60ef19..f7bd5fc9c 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -434,3 +434,24 @@ nonLiteralsToUTF8 ('"':cs) = '"' : l ++ nonLiteralsToUTF8 rs
     takeStringLit (c:cs) = (c:xs,ys)
       where (xs,ys) = takeStringLit cs
 nonLiteralsToUTF8 (c:cs) = encodeUTF8 [c] ++ nonLiteralsToUTF8 cs 
+
+
+printParadigm :: G.Term -> String
+printParadigm term = 
+  if hasTable term then
+    (unlines . map prBranch . branches . head . tables) term
+  else
+    prt term
+ where
+   tables t = case t of
+     G.R rs   -> concatMap (tables . snd . snd) rs
+     G.T _ cs -> [cs]
+     _        -> []
+   hasTable t = not $ null $ tables t
+   branches cs = [(p:ps,s) | 
+                    (p,t) <- cs, 
+                    let ts = tables t,
+                    (ps,s) <- if null ts then [([],t)] 
+                                else concatMap branches ts
+                 ]
+   prBranch (ps,s) = unwords (map prt ps ++ [prt s])
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 2543a8e91..19394855e 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -375,11 +375,12 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
   CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa
 
   CComputeConcrete t -> do
+    let prin = if (oElem (iOpt "table") opts) then printParadigm else prt 
     m <- return $
          maybe (I.identC "?") id $  -- meaningful if no opers in t 
            maybe (resourceOfShellState st) (return . I.identC) $ -- topmost res
              getOptVal opts useResource             -- flag -res=m
-    justOutput opts (putStrLn (err id (prt . stripTerm) (
+    justOutput opts (putStrLn (err id (prin . stripTerm) (
                 string2srcTerm src m t >>= 
                 Ch.justCheckLTerm src  >>=
                 Co.computeConcrete src))) sa
diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 56e1b5903..eebaebd57 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -299,6 +299,7 @@ txtHelpFile =
   "\n      N.B.' The resulting Term is not a term in the sense of abstract syntax," ++
   "\n      and hence not a valid input to a Tree-demanding command." ++
   "\n  flags:" ++
+  "\n     -table    show output in a similar readable format as 'l -table'" ++
   "\n     -res      use another module than the topmost one" ++
   "\n  examples:" ++
   "\n     cc -res=ParadigmsFin (nLukko \"hyppy\")   -- inflect \"hyppy\" with nLukko" ++
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index cdfc75057..1ed778188 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -197,7 +197,7 @@ optionsOfCommand co = case co of
   CApplyTransfer _ -> flags "lang transfer"
   CMorphoAnalyse -> both "short" "lang"
   CTestTokenizer -> flags "lexer"
-  CComputeConcrete _ -> flags "res"
+  CComputeConcrete _ -> both "table" "res"
   CShowOpers _ -> flags "res"
 
   CTranslationQuiz _ _ -> flags "cat"
diff --git a/src/HelpFile b/src/HelpFile
index b1d3f3a83..be06efb0b 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -270,6 +270,7 @@ cc, compute_concrete: cc Term
       N.B.' The resulting Term is not a term in the sense of abstract syntax,
       and hence not a valid input to a Tree-demanding command.
   flags:
+     -table    show output in a similar readable format as 'l -table'
      -res      use another module than the topmost one
   examples:
      cc -res=ParadigmsFin (nLukko "hyppy")   -- inflect "hyppy" with nLukko