Get speechLanguage flag from both command-line and grammar. Reformat it to RFC3066 format (- instead of _) and use it in SRGS, VoiceXML and JSGF.

6 files changed, 32 insertions, 22 deletions

diff --git a/src/GF/Data/Utilities.hs b/src/GF/Data/Utilities.hs
index e0ad08705..74d3ef81e 100644
--- a/src/GF/Data/Utilities.hs
+++ b/src/GF/Data/Utilities.hs
@@ -104,6 +104,10 @@ buildMultiMap :: Ord a => [(a,b)] -> [(a,[b])]
 buildMultiMap = map (\g -> (fst (head g), map snd g) )
                  . sortGroupBy (compareBy fst)
 
+-- | Replace all occurences of an element by another element.
+replace :: Eq a => a -> a -> [a] -> [a]
+replace x y = map (\z -> if z == x then y else z)
+
 -- * equality functions
 
 -- | Use an ordering function as an equality predicate.
diff --git a/src/GF/Speech/GrammarToVoiceXML.hs b/src/GF/Speech/GrammarToVoiceXML.hs
index 961f021f5..b48af5a57 100644
--- a/src/GF/Speech/GrammarToVoiceXML.hs
+++ b/src/GF/Speech/GrammarToVoiceXML.hs
@@ -21,12 +21,13 @@ import GF.Canon.CMacros (noMark, strsFromTerm)
 import GF.Canon.Unlex (formatAsText)
 import GF.Data.Utilities
 import GF.CF.CFIdent (cfCat2Ident)
-import GF.Compile.ShellState (StateGrammar,stateGrammarST,cncId,grammar,startCatStateOpts)
+import GF.Compile.ShellState (StateGrammar,stateGrammarST,cncId,grammar,
+                              startCatStateOpts,stateOptions)
 import GF.Data.Str (sstrV)
 import GF.Grammar.Macros hiding (assign,strsFromTerm)
 import GF.Grammar.Grammar (Fun)
 import GF.Grammar.Values (Tree)
-import GF.Infra.Option (Options)
+import GF.Infra.Option (Options, addOptions, getOptVal, speechLanguage)
 import GF.UseGrammar.GetTree (string2treeErr)
 import GF.UseGrammar.Linear (linTree2strings)
 
@@ -45,10 +46,11 @@ import Debug.Trace
 
 -- | the main function
 grammar2vxml :: Options -> StateGrammar -> String
-grammar2vxml opts s = showsXMLDoc (skel2vxml name language startcat gr' qs) ""
+grammar2vxml opt s = showsXMLDoc (skel2vxml name language startcat gr' qs) ""
     where (name, gr') = vSkeleton (stateGrammarST s)
           qs = catQuestions s (map fst gr')
-          language = "en" -- FIXME: use speechLanguage tag
+          opts = addOptions opt (stateOptions s)
+          language = fmap (replace '_' '-') $ getOptVal opts speechLanguage
           startcat = C.CId $ prIdent $ cfCat2Ident $ startCatStateOpts opts s
 
 --
@@ -117,7 +119,7 @@ getCatQuestion c qs =
 -- * Generate VoiceXML
 --
 
-skel2vxml :: VIdent -> String -> VIdent -> VSkeleton -> CatQuestions -> XML
+skel2vxml :: VIdent -> Maybe String -> VIdent -> VSkeleton -> CatQuestions -> XML
 skel2vxml name language start skel qs = 
     vxml language ([startForm] ++ concatMap (uncurry (catForms gr qs)) skel)
   where 
@@ -169,10 +171,10 @@ catFormId c = prid c ++ "_cat"
 -- * VoiceXML stuff
 --
 
-vxml :: String -> [XML] -> XML
-vxml language = Tag "vxml" [("version","2.0"),
-                            ("xmlns","http://www.w3.org/2001/vxml"),
-                            ("xml:lang", language)]
+vxml :: Maybe String -> [XML] -> XML
+vxml ml = Tag "vxml" $ [("version","2.0"),
+                        ("xmlns","http://www.w3.org/2001/vxml")]
+                      ++ maybe [] (\l -> [("xml:lang", l)]) ml
 
 form :: String -> [XML] -> XML
 form id xs = Tag "form" [("id", id)] xs
diff --git a/src/GF/Speech/PrJSGF.hs b/src/GF/Speech/PrJSGF.hs
index 8b12443a0..f6f0b19b2 100644
--- a/src/GF/Speech/PrJSGF.hs
+++ b/src/GF/Speech/PrJSGF.hs
@@ -34,6 +34,7 @@ import GF.Compile.ShellState (StateGrammar)
 
 import Data.Char
 import Data.List
+import Data.Maybe
 import Text.PrettyPrint.HughesPJ
 import Debug.Trace
 
@@ -44,13 +45,15 @@ jsgfPrinter :: Maybe SISRFormat
 jsgfPrinter sisr opts s = show $ prJSGF sisr $ makeSimpleSRG opts s
 
 prJSGF :: Maybe SISRFormat -> SRG -> Doc
-prJSGF sisr srg@(SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
+prJSGF sisr srg@(SRG{grammarName=name,grammarLanguage=ml,
+                     startCat=start,origStartCat=origStart,rules=rs})
     = header $++$ mainCat $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs)
     where
-    header = text "#JSGF V1.0 UTF-8;" $$
+    header = text "#JSGF" <+> text "V1.0" <+> text "UTF-8" <+> lang <> char ';' $$
              comment ("JSGF speech recognition grammar for " ++ name) $$
              comment "Generated by GF" $$
 	     text ("grammar " ++ name ++ ";") 
+    lang = maybe empty text ml
     mainCat = comment ("Start category: " ++ origStart) $$
 	      rule True "MAIN" [prCat start]
     prRule (SRGRule cat origCat rhs) = 
diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs
index e0754f389..b6af82d32 100644
--- a/src/GF/Speech/PrSRGS.hs
+++ b/src/GF/Speech/PrSRGS.hs
@@ -125,15 +125,15 @@ oneOf = Tag "one-of" []
 
 grammar :: Maybe SISRFormat
         -> String  -- ^ root
-        -> String -- ^language
+        -> Maybe String -- ^language
 	-> [XML] -> XML
-grammar sisr root l = 
-    Tag "grammar" $ [("xml:lang", l),
-                     ("xmlns","http://www.w3.org/2001/06/grammar"),
+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 = Tag "meta" [("name",n),("content",c)] []
diff --git a/src/GF/Speech/PrSRGS_ABNF.hs b/src/GF/Speech/PrSRGS_ABNF.hs
index 2b965e9cb..d79ee7b55 100644
--- a/src/GF/Speech/PrSRGS_ABNF.hs
+++ b/src/GF/Speech/PrSRGS_ABNF.hs
@@ -47,7 +47,7 @@ srgsAbnfPrinter :: Maybe SISRFormat
 srgsAbnfPrinter sisr probs opts s = show $ prABNF sisr probs $ makeSimpleSRG opts s
 
 prABNF :: Maybe SISRFormat -> Bool -> SRG -> Doc
-prABNF sisr probs srg@(SRG{grammarName=name,grammarLanguage = l,
+prABNF sisr probs srg@(SRG{grammarName=name,grammarLanguage=ml,
                      startCat=start,origStartCat=origStart,rules=rs})
     = header $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs)
     where
@@ -57,7 +57,7 @@ prABNF sisr probs srg@(SRG{grammarName=name,grammarLanguage = l,
                 ++ ". " ++ "Original start category: " ++ origStart) $$
              meta "generator" ("Grammatical Framework " ++ version) $$
              language $$ tagFormat $$ mainCat
-    language = text "language" <+> text l <> char ';'
+    language = maybe empty (\l -> text "language" <+> text l <> char ';') ml
     tagFormat | isJust sisr = text "tag-format" <+> text "<semantics/1.0>" <> char ';'
               | otherwise = empty
     mainCat = text "root" <+> prCat start <> char ';'
diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs
index e0a347480..20bdd4a41 100644
--- a/src/GF/Speech/SRG.hs
+++ b/src/GF/Speech/SRG.hs
@@ -42,7 +42,7 @@ import GF.Speech.FiniteState
 import GF.Speech.RegExp
 import GF.Infra.Option
 import GF.Probabilistic.Probabilistic (Probs)
-import GF.Compile.ShellState (StateGrammar, stateProbs, cncId)
+import GF.Compile.ShellState (StateGrammar, stateProbs, stateOptions, cncId)
 
 import Data.List
 import Data.Maybe (fromMaybe, maybeToList)
@@ -54,8 +54,8 @@ import qualified Data.Set as Set
 data SRG = SRG { grammarName :: String    -- ^ grammar name
 		 , startCat :: String     -- ^ start category name
 		 , origStartCat :: String -- ^ original start category name
-                 , grammarLanguage :: String -- ^ The language for which the grammar 
-                                             --   is intended, e.g. en_UK
+                 , grammarLanguage :: Maybe String -- ^ The language for which the grammar 
+                                                   --   is intended, e.g. en-UK
 	         , rules :: [SRGRule] 
 	       }
 	 deriving (Eq,Show)
@@ -100,17 +100,18 @@ makeSRG_ :: (CFRules -> CFRules)
          -> Options   -- ^ Grammar options
 	 -> StateGrammar
 	 -> SRG
-makeSRG_ preprocess opts s =
+makeSRG_ preprocess opt s = 
       SRG { grammarName = name,
 	    startCat = lookupFM_ names origStart,
 	    origStartCat = origStart,
             grammarLanguage = l,
 	    rules = rs }
     where 
+    opts = addOptions opt (stateOptions s)
     name = prIdent (cncId s)
     origStart = getStartCatCF opts s
     probs = stateProbs s
-    l = fromMaybe "en_UK" (getOptVal opts speechLanguage)
+    l = fmap (replace '_' '-') $ getOptVal opts speechLanguage
     (cats,cfgRules) = unzip $ preprocess $ cfgToCFRules s
     names = mkCatNames name cats
     rs = map (cfgRulesToSRGRule names probs) cfgRules