linearizeAll in PGFService

1 files changed, 14 insertions, 1 deletions

diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index f0befb04c..7269c1eee 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -19,7 +19,7 @@ import Control.Exception
 import Control.Monad
 import Data.Char
 import Data.Function (on)
-import Data.List (sortBy,intersperse,mapAccumL)
+import Data.List (sortBy,intersperse,mapAccumL,nub)
 import qualified Data.Map as Map
 import Data.Maybe
 import System.Directory
@@ -88,6 +88,7 @@ pgfMain pgf command =
          "parse"          -> outputJSONP =<< doParse pgf `fmap` getText `ap` getCat `ap` getFrom 
          "complete"       -> outputJSONP =<< doComplete pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getLimit
          "linearize"      -> outputJSONP =<< doLinearize pgf `fmap` getTree `ap` getTo
+         "linearizeAll"   -> outputJSONP =<< doLinearizes pgf `fmap` getTree `ap` getTo
          "random"         -> getCat >>= \c -> getDepth >>= \dp -> getLimit >>= \l -> getTo >>= \to -> liftIO (doRandom pgf c dp l to) >>= outputJSONP
          "generate"       -> outputJSONP =<< doGenerate pgf `fmap` getCat `ap` getDepth `ap` getLimit `ap` getTo
          "translate"      -> outputJSONP =<< doTranslate pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getTo
@@ -268,6 +269,10 @@ doLinearize :: PGF -> PGF.Tree -> Maybe PGF.Language -> JSValue
 doLinearize pgf tree mto = showJSON $ map toJSObject
      [[("to", PGF.showLanguage to),("text",text)] | (to,text) <- linearize' pgf mto tree]
 
+doLinearizes :: PGF -> PGF.Tree -> Maybe PGF.Language -> JSValue
+doLinearizes pgf tree mto = showJSON $ map toJSObject
+     [("to", PGF.showLanguage to):[("text",text) | text <- texts] | (to,texts) <- linearizes' pgf mto tree]
+
 doRandom :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> Maybe PGF.Language -> IO JSValue
 doRandom pgf mcat mdepth mlimit mto =
   do g <- newStdGen
@@ -481,6 +486,14 @@ linearize' pgf mto tree =
       Nothing -> PGF.linearizeAllLang pgf tree
       Just to -> [(to,PGF.linearize pgf to tree)]
 
+-- all variants and their forms
+linearizes' :: PGF -> Maybe PGF.Language -> PGF.Tree -> [(PGF.Language,[String])]
+linearizes' pgf mto tree = case mto of
+  Nothing -> [(to,lins to tree) | to <- PGF.languages pgf]
+  Just to -> [(to,lins to tree)]
+ where
+   lins to = nub . concatMap (map snd) . PGF.tabularLinearizes pgf to
+
 linearizeAndBind pgf mto t = [(la, binds s) | (la,s) <- linearize' pgf mto t]
   where
     binds = unwords . bs . words