From 43459c75c8f74662efd9cfea0cc64e55adc78a44 Mon Sep 17 00:00:00 2001 From: bjorn Date: Thu, 12 Jun 2008 18:24:26 +0000 Subject: Rename GF.Speech.SRGS to GF.Speech.SRGS_XML --- src-3.0/GF/Compile/Export.hs | 2 +- src-3.0/GF/Speech/SRGS.hs | 106 ------------------------------------------ src-3.0/GF/Speech/SRGS_XML.hs | 106 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 107 insertions(+), 107 deletions(-) delete mode 100644 src-3.0/GF/Speech/SRGS.hs create mode 100644 src-3.0/GF/Speech/SRGS_XML.hs diff --git a/src-3.0/GF/Compile/Export.hs b/src-3.0/GF/Compile/Export.hs index 44ea189cb..22b248159 100644 --- a/src-3.0/GF/Compile/Export.hs +++ b/src-3.0/GF/Compile/Export.hs @@ -9,7 +9,7 @@ import GF.Compile.GFCCtoJS import GF.Infra.Option import GF.Speech.CFG import GF.Speech.PGFToCFG -import GF.Speech.SRGS +import GF.Speech.SRGS_XML import GF.Speech.VoiceXML import GF.Text.UTF8 diff --git a/src-3.0/GF/Speech/SRGS.hs b/src-3.0/GF/Speech/SRGS.hs deleted file mode 100644 index 3c36d2526..000000000 --- a/src-3.0/GF/Speech/SRGS.hs +++ /dev/null @@ -1,106 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : SRGS --- --- Prints an SRGS XML speech recognition grammars. ----------------------------------------------------------------------- -module GF.Speech.SRGS (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 -import qualified Data.Set as Set - -srgsXmlPrinter :: Maybe SISRFormat - -> PGF -> CId -> String -srgsXmlPrinter sisr pgf cnc = prSrgsXml sisr $ makeSimpleSRG pgf cnc - -srgsXmlNonRecursivePrinter :: PGF -> CId -> String -srgsXmlNonRecursivePrinter pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG 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 | cat `Set.member` srgExternalCats srg = [("scope","public")] - | otherwise = [] - 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 diff --git a/src-3.0/GF/Speech/SRGS_XML.hs b/src-3.0/GF/Speech/SRGS_XML.hs new file mode 100644 index 000000000..a4c07ee05 --- /dev/null +++ b/src-3.0/GF/Speech/SRGS_XML.hs @@ -0,0 +1,106 @@ +---------------------------------------------------------------------- +-- | +-- 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 +import qualified Data.Set as Set + +srgsXmlPrinter :: Maybe SISRFormat + -> PGF -> CId -> String +srgsXmlPrinter sisr pgf cnc = prSrgsXml sisr $ makeSimpleSRG pgf cnc + +srgsXmlNonRecursivePrinter :: PGF -> CId -> String +srgsXmlNonRecursivePrinter pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG 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 | cat `Set.member` srgExternalCats srg = [("scope","public")] + | otherwise = [] + 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 -- cgit v1.2.3