GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 03:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

linearizeAll in PGFService

Browse Source
This commit is contained in:
aarne
2010-11-24 21:17:29 +00:00
parent b46cbd4d9a
commit 62cfeef03e
1 changed files with 14 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/server/PGFService.hs
View File

@@ -19,7 +19,7 @@ import Control.Exception
import Control.Monad import Control.Monad
import Data.Char import Data.Char
import Data.Function (on) import Data.Function (on)
import Data.List (sortBy,intersperse,mapAccumL) import Data.List (sortBy,intersperse,mapAccumL,nub)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe import Data.Maybe
import System.Directory import System.Directory
@@ -88,6 +88,7 @@ pgfMain pgf command =
"parse" -> outputJSONP =<< doParse pgf `fmap` getText `ap` getCat `ap` getFrom "parse" -> outputJSONP =<< doParse pgf `fmap` getText `ap` getCat `ap` getFrom
"complete" -> outputJSONP =<< doComplete pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getLimit "complete" -> outputJSONP =<< doComplete pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getLimit
"linearize" -> outputJSONP =<< doLinearize pgf `fmap` getTree `ap` getTo "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 "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 "generate" -> outputJSONP =<< doGenerate pgf `fmap` getCat `ap` getDepth `ap` getLimit `ap` getTo
"translate" -> outputJSONP =<< doTranslate pgf `fmap` getText `ap` getCat `ap` getFrom `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 doLinearize pgf tree mto = showJSON $ map toJSObject
[[("to", PGF.showLanguage to),("text",text)] | (to,text) <- linearize' pgf mto tree] [[("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 -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> Maybe PGF.Language -> IO JSValue
doRandom pgf mcat mdepth mlimit mto = doRandom pgf mcat mdepth mlimit mto =
do g <- newStdGen do g <- newStdGen
@@ -481,6 +486,14 @@ linearize' pgf mto tree =
Nothing -> PGF.linearizeAllLang pgf tree Nothing -> PGF.linearizeAllLang pgf tree
Just to -> [(to,PGF.linearize pgf to 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] linearizeAndBind pgf mto t = [(la, binds s) | (la,s) <- linearize' pgf mto t]
where where
binds = unwords . bs . words binds = unwords . bs . words