diff --git a/src/GF/Speech/GrammarToVoiceXML.hs b/src/GF/Speech/GrammarToVoiceXML.hs index 2e3ea1096..16bdb9c78 100644 --- a/src/GF/Speech/GrammarToVoiceXML.hs +++ b/src/GF/Speech/GrammarToVoiceXML.hs @@ -30,11 +30,6 @@ import Data.Maybe (fromMaybe) import Debug.Trace -debug = False - -debugLog xs | debug = blockCond "debug == 1" [prompt xs] - | otherwise = Empty - -- | the main function grammar2vxml :: String -> StateGrammar -> String grammar2vxml startcat gr = showsXMLDoc (skel2vxml name language startcat gr' qs) "" @@ -107,48 +102,14 @@ getCatQuestion c qs = skel2vxml :: String -> String -> VIdent -> VSkeleton -> CatQuestions -> XML skel2vxml name language start skel qs = - vxml language (prelude ++ [startForm] ++ concatMap (uncurry (catForms gr qs)) skel) + vxml language ([startForm] ++ concatMap (uncurry (catForms gr qs)) skel) where gr = grammarURI name - prelude = if debug then [var "debug" (Just "0")] ++ scriptLib else [] - startForm = Tag "form" [] [subdialog "sub" [("src", "#"++start)] []] + startForm = Tag "form" [] [subdialog "sub" [("src", "#"++catFormId start)] []] grammarURI :: String -> String grammarURI name = name ++ ".grxml" -scriptLib :: [XML] -scriptLib = [script (unlines s)] - where - s = ["function dump(r, p) {", - " if (isUndefined(p)) { p = 0 }", - " if (isUndefined(r)) {", - " return '*undefined*';", - " } else if (isArray(r)) {", - " var s = '[';", - " for (var i = 0; i < r.length; r++) {", - " s += dump(r[0], 0);", - " if (i < r.length-1) { s += ',' }", - " }", - " s += ']';", - " return s;", - " } else if (r == '?') {", - " return '?';", - " } else {", - " var s = r.name;", - " var i;", - " for (i = 0; ; i++) {", - " var c = r['arg'+i];", - " if (isUndefined(c)) { break; }", - " s += ' ' + dump(c, 1);", - " }", - " if (i > 0 && p > 0) { s = '(' + s + ')'; }", - " return s;", - " }", - "}", - "function isArray(a) { return a && typeof a == 'object' && a.constructor == Array; }", - "function isUndefined(a) { return typeof a == 'undefined'; }" - ] - catForms :: String -> CatQuestions -> VIdent -> [(VIdent, [VIdent])] -> [XML] catForms gr qs cat fs = @@ -157,34 +118,37 @@ catForms gr qs cat fs = cat2form :: String -> CatQuestions -> VIdent -> [(VIdent, [VIdent])] -> XML cat2form gr qs cat fs = - form cat $ [var "value" (Just "'?'"), - var "update" Nothing, - formDebug cat, - blockCond "value != '?'" [assign cat "value"], - field cat [] [promptString (getCatQuestion cat qs), - grammar (gr++"#"++cat), - nomatch [Data "I didn't understand you.", reprompt], - help [Data ("help_"++cat)], - filled [] [if_else (cat ++ " == '?'") [reprompt] feedback]], - catDebug] - ++ concatMap (uncurry (fun2sub gr cat)) fs - ++ [block [return_ [cat]]] - where feedback = [if_ ("typeof update != 'undefined' && !update("++string cat++","++ cat ++ ")") [return_ []]] - catDebug = debugLog [Data (cat ++ " = "), value ("dump("++cat++")")] - retDebug = debugLog [Data "return ", value ("dump("++cat++")")] + form (catFormId cat) $ + [var "value" (Just "'?'"), + var "update" Nothing, + blockCond "value != '?'" [assign (catFieldId cat) "value"], + field (catFieldId cat) [] + [promptString (getCatQuestion cat qs), + grammar (gr++"#"++catFormId cat), + nomatch [Data "I didn't understand you.", reprompt], + help [Data ("help_"++cat)], + filled [] [if_else (catFieldId cat ++ " == '?'") [reprompt] feedback]] + ] + ++ concatMap (uncurry (fun2sub gr cat)) fs + ++ [block [return_ [catFieldId cat]]] + where feedback = [if_ ("typeof update != 'undefined' && !update("++string cat++","++ catFieldId cat ++ ")") [return_ []]] fun2sub :: String -> VIdent -> VIdent -> [VIdent] -> [XML] fun2sub gr cat fun args = comments [fun ++ " : " ++ cat] ++ ss where argNames = zip ["arg"++show n | n <- [0..]] args ss = map (uncurry mkSub) argNames - mkSub a t = subdialog s [("src","#"++t),("cond",cat++".name == "++string fun)] - [param "value" (cat++"."++a), + mkSub a t = subdialog s [("src","#"++catFormId t),("cond",catFieldId cat++".name == "++string fun)] + [param "value" (catFieldId cat++"."++a), param "update" "update", - filled [] [assign (cat++"."++a) (s++"."++t)]] + filled [] [assign (catFieldId cat++"."++a) (s++"."++catFieldId t)]] where s = fun ++ "_" ++ a -formDebug id = debugLog [Data ("Entering form " ++ id ++ ". value = "), value "dump(value)"] +catFormId :: VIdent -> String +catFormId = (++ "_cat") + +catFieldId :: VIdent -> String +catFieldId = (++ "_field") -- -- * VoiceXML stuff diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs index 63ca91034..2a7e99d07 100644 --- a/src/GF/Speech/PrSRGS.hs +++ b/src/GF/Speech/PrSRGS.hs @@ -50,7 +50,7 @@ prSrgsXml sisr (SRG{grammarName=name,startCat=start, = showsXMLDoc $ optimizeSRGS xmlGr where root = cfgCatToGFCat origStart - xmlGr = grammar sisr root l $ + xmlGr = grammar sisr (catFormId root) l $ [meta "description" ("SRGS XML speech recognition grammar for " ++ name ++ ". " ++ "Original start category: " ++ origStart), @@ -59,14 +59,14 @@ prSrgsXml sisr (SRG{grammarName=name,startCat=start, ++ topCatRules ++ concatMap ruleToXML rs ruleToXML (SRGRule cat origCat alts) = - comments ["Category " ++ origCat] ++ [rule (prCat cat) (prRhs $ ebnfSRGAlts alts)] + comments ["Category " ++ origCat] ++ [rule cat (prRhs $ ebnfSRGAlts alts)] prRhs rhss = [oneOf (map (mkProd sisr) rhss)] -- externally visible rules for each of the GF categories topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- topCats] where topCats = buildMultiMap [(cfgCatToGFCat origCat, cat) | SRGRule cat origCat _ <- rs] - it i c = Tag "item" [] [Tag "ruleref" [("uri","#" ++ prCat c)] [], - tag sisr [(EThis :. i) := (ERef c)]] - topRule i is = Tag "rule" [("id",i),("scope","public")] is + it i c = Tag "item" [] [Tag "ruleref" [("uri","#" ++ c)] [], + tag sisr [(EThis :. catFieldId i) := (ERef c)]] + topRule i is = Tag "rule" [("id",catFormId i),("scope","public")] is rule :: String -> [XML] -> XML rule i = Tag "rule" [("id",i)] @@ -94,18 +94,23 @@ mkItem sisr = f f (RESymbol s) = symItem sisr s symItem :: Maybe SISRFormat -> Symbol SRGNT Token -> XML -symItem sisr (Cat (c,slots)) = Tag "item" [] ([Tag "ruleref" [("uri","#" ++ prCat c)] []]++t) +symItem sisr (Cat (c,slots)) = Tag "item" [] ([Tag "ruleref" [("uri","#" ++ c)] []]++t) where t = if null ts then [] else [tag sisr ts] - ts = [(EThis :. ("arg" ++ show s)) := (ERef (prCat c)) | s <- slots] + ts = [(EThis :. ("arg" ++ show s)) := (ERef c) | s <- slots] symItem _ (Tok t) = Tag "item" [] [Data (showToken t)] tag :: Maybe SISRFormat -> [SISRExpr] -> XML tag Nothing _ = Empty tag (Just fmt) ts = Tag "tag" [] [Data (join "; " (map (prSISR fmt) ts))] -prCat :: String -> String -prCat c = c + +catFormId :: String -> String +catFormId = (++ "_cat") + +catFieldId :: String -> String +catFieldId = (++ "_field") + showToken :: Token -> String showToken t = t