diff options
Diffstat (limited to 'src/GF/Speech/SRGS_XML.hs')
| -rw-r--r-- | src/GF/Speech/SRGS_XML.hs | 105 |
1 files changed, 0 insertions, 105 deletions
diff --git a/src/GF/Speech/SRGS_XML.hs b/src/GF/Speech/SRGS_XML.hs deleted file mode 100644 index 1f94de66d..000000000 --- a/src/GF/Speech/SRGS_XML.hs +++ /dev/null @@ -1,105 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.Speech.SRGS_XML --- --- Prints an SRGS XML speech recognition grammars. ----------------------------------------------------------------------- -module GF.Speech.SRGS_XML (srgsXmlPrinter, srgsXmlNonRecursivePrinter) where - -import GF.Data.Utilities -import GF.Data.XML -import GF.Infra.Option -import GF.Speech.CFG -import GF.Speech.RegExp -import GF.Speech.SISR as SISR -import GF.Speech.SRG -import PGF (PGF, CId) - -import Control.Monad -import Data.Char (toUpper,toLower) -import Data.List -import Data.Maybe -import qualified Data.Map as Map - -srgsXmlPrinter :: Options - -> PGF -> CId -> String -srgsXmlPrinter opts pgf cnc = prSrgsXml sisr $ makeNonLeftRecursiveSRG opts pgf cnc - where sisr = flag optSISR opts - -srgsXmlNonRecursivePrinter :: Options -> PGF -> CId -> String -srgsXmlNonRecursivePrinter opts pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG opts pgf cnc - - -prSrgsXml :: Maybe SISRFormat -> SRG -> String -prSrgsXml sisr srg = showXMLDoc (optimizeSRGS xmlGr) - where - xmlGr = grammar sisr (srgStartCat srg) (srgLanguage srg) $ - [meta "description" - ("SRGS XML speech recognition grammar for " ++ srgName srg ++ "."), - meta "generator" "Grammatical Framework"] - ++ map ruleToXML (srgRules srg) - ruleToXML (SRGRule cat alts) = Tag "rule" ([("id",cat)]++pub) (prRhs alts) - where pub = if isExternalCat srg cat then [("scope","public")] else [] - prRhs rhss = [oneOf (map (mkProd sisr) rhss)] - -mkProd :: Maybe SISRFormat -> SRGAlt -> XML -mkProd sisr (SRGAlt mp n rhs) = Tag "item" [] (ti ++ [x] ++ tf) - where x = mkItem sisr n rhs - ti = tag sisr (profileInitSISR n) - tf = tag sisr (profileFinalSISR n) - -mkItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> XML -mkItem sisr cn = f - where - f (REUnion []) = ETag "ruleref" [("special","VOID")] - f (REUnion xs) - | not (null es) = Tag "item" [("repeat","0-1")] [f (REUnion nes)] - | otherwise = oneOf (map f xs) - where (es,nes) = partition isEpsilon xs - f (REConcat []) = ETag "ruleref" [("special","NULL")] - f (REConcat xs) = Tag "item" [] (map f xs) - f (RERepeat x) = Tag "item" [("repeat","0-")] [f x] - f (RESymbol s) = symItem sisr cn s - -symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML -symItem sisr cn (NonTerminal n@(c,_)) = - Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)]] ++ tag sisr (catSISR cn n) -symItem _ _ (Terminal t) = Tag "item" [] [Data (showToken t)] - -tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> [XML] -tag Nothing _ = [] -tag (Just fmt) t = case t fmt of - [] -> [] - ts -> [Tag "tag" [] [Data (prSISR ts)]] - -showToken :: Token -> String -showToken t = t - -oneOf :: [XML] -> XML -oneOf = Tag "one-of" [] - -grammar :: Maybe SISRFormat - -> String -- ^ root - -> Maybe String -- ^language - -> [XML] -> XML -grammar sisr root ml = - Tag "grammar" $ [("xmlns","http://www.w3.org/2001/06/grammar"), - ("version","1.0"), - ("mode","voice"), - ("root",root)] - ++ (if isJust sisr then [("tag-format","semantics/1.0")] else []) - ++ maybe [] (\l -> [("xml:lang", l)]) ml - -meta :: String -> String -> XML -meta n c = ETag "meta" [("name",n),("content",c)] - -optimizeSRGS :: XML -> XML -optimizeSRGS = bottomUpXML f - where f (Tag "item" [] [x@(Tag "item" _ _)]) = x - f (Tag "item" [] [x@(Tag "one-of" _ _)]) = x - f (Tag "item" as [Tag "item" [] xs]) = Tag "item" as xs - f (Tag "item" as xs) = Tag "item" as (map g xs) - where g (Tag "item" [] [x@(ETag "ruleref" _)]) = x - g x = x - f (Tag "one-of" [] [x]) = x - f x = x |