From cd25764350581175cbca828486353cd6cc4f151a Mon Sep 17 00:00:00 2001
From: aarne <aarne@chalmers.se>
Date: Mon, 22 Mar 2010 22:04:36 +0000
Subject: [PATCH] www api command translategroup, which uses groupResults

---
 src/server/PGFService.hs | 29 ++++++++++++++++++++++++++---
 1 file changed, 26 insertions(+), 3 deletions(-)

diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index 36f3f9663..6f53d3768 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -51,6 +51,7 @@ pgfMain pgf command =
          "linearize"      -> return (doLinearize pgf) `ap` getTree `ap` getTo >>= outputJSONP
          "random"         -> getCat >>= \c -> getLimit >>= liftIO . doRandom pgf c >>= outputJSONP
          "translate"      -> return (doTranslate pgf) `ap` getText `ap` getCat `ap` getFrom `ap` getTo >>= outputJSONP
+         "translategroup" -> return (doTranslateGroup pgf) `ap` getText `ap` getCat `ap` getFrom `ap` getTo >>= outputJSONP
          "grammar"        -> return (doGrammar pgf) `ap` requestAcceptLanguage >>= outputJSONP
          "abstrtree"      -> getTree >>= liftIO . doGraphvizAbstrTree pgf >>= outputPNG
          "parsetree"      -> getTree >>= \t -> getFrom >>= \(Just l) -> liftIO (doGraphvizParseTree pgf l t) >>= outputPNG
@@ -113,12 +114,34 @@ doTranslate pgf input mcat mfrom mto =
   showJSON
      [toJSObject [("from",          showJSON (PGF.showLanguage from)),
                   ("tree",          showJSON tree),
-                  ("linearizations",showJSON [toJSObject [("to", PGF.showLanguage to),("text",output)]
-                                                   | (to,output) <- linearize' pgf mto tree])
+                  ("linearizations",showJSON 
+                     [toJSObject [("to", PGF.showLanguage to),("text",output)]
+                       | (to,output) <- linearize' pgf mto tree]
+                  )
                  ]
            | (from,trees) <- parse' pgf input mcat mfrom,
              tree <- trees]
 
+doTranslateGroup :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> Maybe PGF.Language -> JSValue
+doTranslateGroup pgf input mcat mfrom mto =
+  showJSON
+     [toJSObject [("from",          showJSON (PGF.showLanguage from)),
+                  ("to",            showJSON (PGF.showLanguage to)),
+                  ("linearizations",showJSON 
+                                      [toJSObject [("text", unlines output)]])
+                 ]
+        | 
+          (from,trees) <- parse' pgf input mcat mfrom,
+          (to,output)  <- groupResults (map (linearize' pgf mto) trees) 
+          ]
+  where
+   groupResults = Map.toList . foldr more Map.empty . start . concat
+     where
+       start ls = [(l,[s]) | (l,s) <- ls]
+       more (l,s) = 
+         Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s
+
+
 doParse :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> JSValue
 doParse pgf input mcat mfrom = showJSON $ map toJSObject
      [[("from", PGF.showLanguage from),("tree",PGF.showExpr [] tree)]
@@ -265,4 +288,4 @@ langCodeLanguage pgf code = listToMaybe [l | l <- PGF.languages pgf, PGF.languag
 -- * General utilities
 
 cleanFilePath :: FilePath -> FilePath
-cleanFilePath = takeFileName
\ No newline at end of file
+cleanFilePath = takeFileName