msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

PGF service & minibar: only show dependency diagrams if the labels are known

Browse Source 
+ The PGF service now reads and caches dependency label configuration files.
+ The grammar info returned by command=grammar has a new boolean field 
  'hasDependencyLabels' to indicate if dependency labels were found for
  the grammar. Also, command=deptree will now fail if no labels are present.
+ The minibar only shows word dependency trees if labels are present.
+ Also changed the type of getDepLabels from [String] -> Labels to
  String -> Labels, since all uses were in the form "getDepLabels . lines".
This commit is contained in:
hallgren
2016-06-09 13:12:14 +00:00
parent 617624e2a8
commit 096b4cfcee
6 changed files with 61 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Command/Commands.hs
View File

@@ -551,7 +551,7 @@ pgfCommands = Map.fromList [
let outp = valStrOpts "output" "dot" opts
mlab <- case file of
"" -> return Nothing
_ -> (Just . getDepLabels . lines) `fmap` restricted (readFile file)
_ -> (Just . getDepLabels) `fmap` restricted (readFile file)
let lang = optLang pgf opts
let grphs = map (graphvizDependencyTree outp debug mlab Nothing pgf lang) es
if isOpt "conll2latex" opts
@@ -616,7 +616,7 @@ pgfCommands = Map.fromList [
let depfile = valStrOpts "file" "" opts
mlab <- case depfile of
"" -> return Nothing
_ -> (Just . getDepLabels . lines) `fmap` restricted (readFile depfile)
_ -> (Just . getDepLabels) `fmap` restricted (readFile depfile)
let grphs = map (graphvizParseTreeDep mlab pgf lang gvOptions) es
if isFlag "view" opts || isFlag "format" opts
then do

2
src/compiler/GF/Server.hs
View File

@@ -174,7 +174,7 @@ handle logLn documentroot state0 cache execute1 stateVar
(_ ,_ ,".pgf") -> do --debug $ "PGF service: "++path
wrapCGI $ PS.cgiMain' cache path
(dir,"grammars.cgi",_ ) -> grammarList dir (decoded qs)
(dir ,"exb.fcgi" ,_ ) -> wrapCGI $ ES.cgiMain' root dir (fst cache)
(dir ,"exb.fcgi" ,_ ) -> wrapCGI $ ES.cgiMain' root dir (PS.pgfCache cache)
_ -> serveStaticFile rpath path
where path = translatePath rpath
_ -> return $ resp400 upath

2
src/runtime/haskell/PGF.hs
View File

@@ -131,7 +131,7 @@ module PGF(
graphvizDefaults,
conlls2latexDoc,
-- extra:
getDepLabels,
Labels, getDepLabels,
-- * Probabilities
Probabilities,

6
src/runtime/haskell/PGF/VisualizeTree.hs
View File

@@ -16,7 +16,7 @@ module PGF.VisualizeTree
, graphvizParseTree
, graphvizParseTreeDep
, graphvizDependencyTree
, getDepLabels
, Labels, getDepLabels
, graphvizBracketedString
, graphvizAlignment
, gizaAlignment
@@ -232,8 +232,8 @@ graphvizDependencyTree format debug mlab ms pgf lang t =
-- | Prepare lines obtained from a configuration file for labels for
-- use with 'graphvizDependencyTree'. Format per line /fun/ /label/@*@.
getDepLabels :: [String] -> Labels
getDepLabels ss = Map.fromList [(mkCId f,ls) | f:ls <- map words ss]
getDepLabels :: String -> Labels
getDepLabels s = Map.fromList [(mkCId f,ls) | f:ls <- map words (lines s)]
-- the old function, without dependencies
graphvizParseTree :: PGF -> Language -> GraphvizOptions -> Tree -> String

83
src/server/PGFService.hs
View File

@@ -1,9 +1,9 @@
{-# LANGUAGE CPP #-}
module PGFService(cgiMain,cgiMain',getPath,
logFile,stderrToFile,
newPGFCache,flushPGFCache,listPGFCache) where
Caches,pgfCache,newPGFCache,flushPGFCache,listPGFCache) where
import PGF (PGF)
import PGF (PGF,Labels)
import qualified PGF
import PGF.Lexing
import Cache
@@ -46,9 +46,9 @@ import System.Random
import System.Process
import System.Exit
import System.IO
import System.IO.Error(isDoesNotExistError,tryIOError)
import System.IO.Error(isDoesNotExistError)
import System.Directory(removeFile)
import System.FilePath(dropExtension,(<.>))
import System.FilePath(dropExtension,takeDirectory,(</>),(<.>))
import System.Mem(performGC)
import Fold(fold) -- transfer function for OpenMath LaTeX
@@ -61,26 +61,32 @@ logFile :: FilePath
logFile = "pgf-error.log"
#ifdef C_RUNTIME
type Caches = (Cache PGF,(Cache (C.PGF,({-MVar ParseCache-})),QSem))
data Caches = Caches { pgfCache::Cache PGF,
labelsCache::Cache Labels,
cpgfCache::(Cache (C.PGF,({-MVar ParseCache-})),QSem) }
--type Caches = (Cache PGF,Cache (C.PGF,({-MVar ParseCache-})))
--type ParseCache = Map.Map (String,String) (ParseResult,UTCTime)
--type ParseResult = Either String [(C.Expr,Float)]
newPGFCache jobs = do pgfCache <- newCache' PGF.readPGF
lblCache <- newCache' (fmap PGF.getDepLabels . readFile)
let n = maybe 4 id jobs
qsem <- newQSem n
cCache <- newCache' $ \ path -> do pgf <- C.readPGF path
--pc <- newMVar Map.empty
return (pgf,({-pc-}))
return (pgfCache,(cCache,qsem))
flushPGFCache (c1,(c2,_)) = flushCache c1 >> flushCache c2
listPGFCache (c1,(c2,_)) = (,) # listCache c1 % listCache c2
return $ Caches pgfCache lblCache (cCache,qsem)
flushPGFCache c = do flushCache (pgfCache c)
flushCache (labelsCache c)
flushCache (fst (cpgfCache c))
listPGFCache c = (,) # listCache (pgfCache c) % listCache (fst (cpgfCache c))
#else
type Caches = (Cache PGF,())
data Caches = Caches { pgfCache::Cache PGF, labelsCache::Cache Labels}
newPGFCache _ = do pgfCache <- newCache' PGF.readPGF
return (pgfCache,())
flushPGFCache (c1,_) = flushCache c1
listPGFCache (c1,_) = (,) # listCache c1 % return []
lblCache <- newCache' (fmap PGF.getDepLabels . readFile)
return $ Caches pgfCache lblCache
flushPGFCache c = flushCache (pgfCache c)
listPGFCache c = (,) # listCache (pgfCache c) % return []
#endif
newCache' rd = do c <- newCache rd
@@ -105,15 +111,21 @@ cgiMain' cache path =
do command <- liftM (maybe "grammar" (urlDecodeUnicode . UTF8.decodeString))
(getInput "command")
case command of
"download" -> outputBinary =<< getFile BS.readFile path
'c':'-':_ ->
"download" -> outputBinary =<< getFile BS.readFile path
'c':'-':_ -> optionalCpgfMain cache path command
_ -> do tpgf <- getFile (readCache' (pgfCache cache)) path
pgfMain (labelsCache cache) path command tpgf
optionalCpgfMain cache path command =
#ifdef C_RUNTIME
cpgfMain (snd (snd cache)) command
=<< getFile (readCache' (fst (snd cache))) path
cpgfMain (snd (cpgfCache cache)) command
=<< getFile (readCache' (fst (cpgfCache cache))) path
#else
serverError "Server configured without C run-time support" ""
serverError "Server configured without C run-time support" ""
serverError = throw 500
#endif
_ -> pgfMain path command =<< getFile (readCache' (fst cache)) path
getFile get path =
either failed return =<< liftIO (E.try (get path))
@@ -312,10 +324,6 @@ instance ToATree C.Expr where
showTree = show
toATree = cToATree
#else
serverError = throw 500
#endif
--------------------------------------------------------------------------------
@@ -381,8 +389,8 @@ unlexerH = maybe (return doBind) unlexerfun =<< getInput "unlexer"
--------------------------------------------------------------------------------
-- * Haskell run-time functionality
--pgfMain :: FilePath -> String -> PGF -> CGI CGIResult
pgfMain path command (t,pgf) =
--pgfMain :: Cache Labels -> FilePath -> String -> PGF -> CGI CGIResult
pgfMain lc path command tpgf@(t,pgf) =
case command of
"parse" -> o =<< doParse pgf # input % cat % limit % treeopts
"complete" -> o =<< doComplete pgf # input % cat % limit % full
@@ -394,11 +402,13 @@ pgfMain path command (t,pgf) =
"translate" -> o =<< doTranslate pgf # input % cat %to%limit%treeopts
"translategroup" -> o =<< doTranslateGroup pgf # input % cat % to % limit
"lookupmorpho" -> o =<< doLookupMorpho pgf # from1 % textInput
"grammar" -> o =<< doGrammar t pgf # requestAcceptLanguage
"grammar" -> join $ doGrammar tpgf
# liftIO (E.try (getLabels lc path pgf))
% requestAcceptLanguage
"abstrtree" -> outputGraphviz =<< abstrTree pgf # graphvizOptions % tree
"alignment" -> outputGraphviz =<< alignment pgf # tree % to
"parsetree" -> outputGraphviz =<< parseTree pgf # from1 % graphvizOptions % tree
"deptree" -> join $ doDepTree path pgf # format "dot" % to1 % tree
"deptree" -> join $ doDepTree lc path pgf # format "dot" % to1 % tree
"abstrjson" -> o . jsonExpr =<< tree
"browse" -> join $ doBrowse pgf # optId % cssClass % href % format "html" % getIncludePrintNames
"external" -> do cmd <- getInput "external"
@@ -740,16 +750,18 @@ doGenerate pgf mcat mdepth mlimit tos =
limit = take (fromMaybe 1 mlimit)
depth = fromMaybe 4 mdepth
doGrammar :: UTCTime -> PGF -> Maybe (Accept Language) -> JSValue
doGrammar t pgf macc = showJSON $ makeObj
doGrammar :: (UTCTime,PGF) -> Either IOError (UTCTime,l) -> Maybe (Accept Language) -> CGI CGIResult
doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj
["name".=PGF.abstractName pgf,
"lastmodified".=show t,
"hasDependencyLabels".=either (const False) (const True) elbls,
"userLanguage".=selectLanguage pgf macc,
"startcat".=PGF.showType [] (PGF.startCat pgf),
"categories".=categories,
"functions".=functions,
"languages".=languages]
where
t = either (const t1) (max t1 . fst) elbls
languages =
[makeObj ["name".= l,
"languageCode".= fromMaybe "" (PGF.languageCode pgf l)]
@@ -778,17 +790,22 @@ abstrTree pgf opts tree = PGF.graphvizAbstractTree pgf opts' tree
parseTree pgf lang opts tree = PGF.graphvizParseTree pgf lang opts tree
doDepTree path pgf fmt lang tree =
do lbls <- either (const Nothing) Just # liftIO (tryIOError readDepLabels)
let vis = PGF.graphvizDependencyTree fmt False lbls Nothing pgf lang tree
doDepTree lc path pgf fmt lang tree =
do (_,lbls) <- liftIO $ getLabels lc path pgf
let vis = PGF.graphvizDependencyTree fmt False (Just lbls) () pgf lang tree
if fmt `elem` ["png","gif","gv"]
then outputGraphviz vis
else if fmt=="svg"
then outputText "image/svg+xml" vis
else outputPlain vis
getLabels lc path pgf =
msum [readCache' lc path | path<-[{-path1,-}path2,path3]]
where
labelsPath = dropExtension path <.> "labels"
readDepLabels = PGF.getDepLabels . lines # readFile labelsPath
dir = takeDirectory path
--path1 = dir</> ...labels flag from abstract syntax...
path2 = dir</>PGF.showCId (PGF.abstractName pgf)<.>"labels"
path3 = dropExtension path <.> "labels"
alignment pgf tree (tos,unlex) = PGF.graphvizAlignment pgf tos' tree
where tos' = if null tos then PGF.languages pgf else tos

8
src/www/minibar/minibar_translations.js
View File

@@ -135,7 +135,7 @@ Translations.prototype.show_translations=function(translationResults) {
var ts = text_speech(langcode,to,txt,lin)
var as = wrap("span",
self.options.show_trees
? [self.parsetree_button(tree,to),text(" "),ts]
? [self.parsetree_button(tree,to,self.grammar),text(" "),ts]
: [ts])
as.active=txt
as.swap=ts
@@ -225,7 +225,7 @@ Translations.prototype.show_translations=function(translationResults) {
var hdr=title("Switch input language to "+langcode,
button(langcode,act(lin[i])))
//hdr.disabled=lin[i].to==current.from
var btn=parsetree_button(t.tree,lin[i].to)
var btn=parsetree_button(t.tree,lin[i].to,grammar)
tbody.appendChild(
tr([th(hdr),show_lin(langcode,lin[i],t.tree)]));
}
@@ -288,14 +288,14 @@ Translations.prototype.alignment_button=function(abs,all,toLangs) {
return i;
}
Translations.prototype.parsetree_button=function(abs,lang) {
Translations.prototype.parsetree_button=function(abs,lang,grammar) {
var f=this.options.tree_img_format;
var img=this.server.current_grammar_url
+"?command=parsetree&format="+f+"&nodep=true&nodefont=arial"
+"&from="+lang+"&tree="+encodeURIComponent(abs);
var img_nofun=img+"&nofun=true"
var help="Click again to display parse tree. Click again to show function names."
if(f=="svg") {
if(f=="svg" && grammar.hasDependencyLabels) {
var depimg=this.server.current_grammar_url
+"?command=deptree&format=svg&to="+lang
+"&tree="+encodeURIComponent(abs);