removed src for 2.9

1 files changed, 0 insertions, 285 deletions

diff --git a/src/GF/Speech/GrammarToVoiceXML.hs b/src/GF/Speech/GrammarToVoiceXML.hs
deleted file mode 100644
index ad7f25d1c..000000000
--- a/src/GF/Speech/GrammarToVoiceXML.hs
+++ /dev/null
@@ -1,285 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GrammarToVoiceXML
--- Maintainer  : Bjorn Bringert
--- Stability   : (stable)
--- Portability : (portable)
---
--- Create VoiceXML dialogue system from a GF grammar.
------------------------------------------------------------------------------
-
-module GF.Speech.GrammarToVoiceXML (grammar2vxml) where
-
-import GF.Canon.CanonToGFCC (canon2gfcc)
-import qualified GF.GFCC.CId as C
-import GF.GFCC.DataGFCC (GFCC(..), Abstr(..))
-import GF.GFCC.Macros
-import qualified GF.Canon.GFC as GFC
-import GF.Canon.AbsGFC (Term)
-import GF.Canon.PrintGFC (printTree)
-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,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, addOptions, getOptVal, speechLanguage)
-import GF.UseGrammar.GetTree (string2treeErr)
-import GF.UseGrammar.Linear (linTree2strings)
-
-import GF.Infra.Ident
-import GF.Infra.Option (noOptions)
-import GF.Infra.Modules
-import GF.Data.Operations
-
-import GF.Data.XML
-
-import Control.Monad (liftM)
-import Data.List (isPrefixOf, find, intersperse)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
-
-import Debug.Trace
-
--- | the main function
-grammar2vxml :: Options -> StateGrammar -> String
-grammar2vxml opt s = showsXMLDoc (skel2vxml name language startcat gr' qs) ""
-    where (_, gr') = vSkeleton (stateGrammarST s)
-          name = prIdent (cncId s)
-          qs = catQuestions s (map fst gr')
-          opts = addOptions opt (stateOptions s)
-          language = fmap (replace '_' '-') $ getOptVal opts speechLanguage
-          startcat = C.CId $ prIdent $ cfCat2Ident $ startCatStateOpts opts s
-
---
--- * VSkeleton: a simple description of the abstract syntax.
---
-
-type VSkeleton = [(VIdent, [(VIdent, [VIdent])])]
-type VIdent = C.CId
-
-prid :: VIdent -> String
-prid (C.CId x) = x
-
-vSkeleton :: GFC.CanonGrammar -> (VIdent,VSkeleton)
-vSkeleton = gfccSkeleton . canon2gfcc noOptions
-
-gfccSkeleton :: GFCC -> (VIdent,VSkeleton)
-gfccSkeleton gfcc = (absname gfcc, ts)
-  where a = abstract gfcc
-        ts = [(c,[(f,ft f) | f <- fs]) | (c,fs) <- Map.toList (catfuns a)]
-        ft f = case lookMap (error $ prid f) f (funs a) of
-                 (ty,_) -> fst $ GF.GFCC.Macros.catSkeleton ty
-
---
--- * Questions to ask 
---
-
-type CatQuestions = [(VIdent,String)]
-
-catQuestions :: StateGrammar -> [VIdent] -> CatQuestions
-catQuestions gr cats = [(c,catQuestion gr c) | c <- cats]
-
-catQuestion :: StateGrammar -> VIdent -> String
-catQuestion gr cat = err errHandler id (getPrintname gr cat >>= term2string)
-  where -- FIXME: use some better warning facility
-        errHandler e = trace ("GrammarToVoiceXML: " ++ e) ("quest_"++prid cat)
-        term2string = liftM sstrV . strsFromTerm
-
-getPrintname :: StateGrammar -> VIdent -> Err Term
-getPrintname gr cat = 
-    do m <- lookupModMod (grammar gr) (cncId gr)
-       i <- lookupInfo m (IC (prid cat))
-       case i of
-         GFC.CncCat _ _ p -> return p
-         _ -> fail $ "getPrintname " ++ prid cat
-                      ++ ": Expected CncCat, got " ++ show i
-
-
-{-
-lin :: StateGrammar -> String -> Err String
-lin gr fun = do
-             tree <- string2treeErr gr fun
-             let ls = map unt $ linTree2strings noMark g c tree
-             case ls of
-                 [] -> fail $ "No linearization of " ++ fun
-                 l:_ -> return l
-  where c = cncId gr
-        g = stateGrammarST gr
-        unt = formatAsText 
--}
-
-getCatQuestion :: VIdent -> CatQuestions -> String
-getCatQuestion c qs = 
-    fromMaybe (error "No question for category " ++ prid c) (lookup c qs)
-
---
--- * Generate VoiceXML
---
-
-skel2vxml :: String -> Maybe String -> VIdent -> VSkeleton -> CatQuestions -> XML
-skel2vxml name language start skel qs = 
-    vxml language ([startForm] ++ concatMap (uncurry (catForms gr qs)) skel)
-  where 
-  gr = grammarURI name
-  startForm = Tag "form" [] [subdialog "sub" [("src", "#"++catFormId start)] 
-                                           [param "old" "{ name : '?' }"]]
-
-grammarURI :: String -> String
-grammarURI name = name ++ ".grxml"
-
-
-catForms :: String -> CatQuestions -> VIdent -> [(VIdent, [VIdent])] -> [XML]
-catForms gr qs cat fs = 
-    comments [prid cat ++ " category."]
-    ++ [cat2form gr qs cat fs] 
-
-cat2form :: String -> CatQuestions -> VIdent -> [(VIdent, [VIdent])] -> XML
-cat2form gr qs cat fs = 
-  form (catFormId cat) $ 
-      [var "old" Nothing, 
-       blockCond "old.name != '?'" [assign "term" "old"],
-       field "term" []
-           [promptString (getCatQuestion cat qs), 
-            vxmlGrammar (gr++"#"++catFormId cat)
-           ]
-      ]
-     ++ concatMap (uncurry (fun2sub gr cat)) fs
-     ++ [block [return_ ["term"]{-]-}]]
-
-fun2sub :: String -> VIdent -> VIdent -> [VIdent] -> [XML]
-fun2sub gr cat fun args = 
-    comments [prid fun ++ " : (" 
-              ++ concat (intersperse ", " (map prid args))
-              ++ ") " ++ prid cat] ++ ss
-  where 
-  ss = zipWith mkSub [0..] args
-  mkSub n t = subdialog s [("src","#"++catFormId t),
-                           ("cond","term.name == "++string (prid fun))] 
-              [param "old" v,
-               filled [] [assign v (s++".term")]]
-    where s = prid fun ++ "_" ++ show n
-          v = "term.args["++show n++"]"
-
-catFormId :: VIdent -> String
-catFormId c = prid c ++ "_cat"
-
-
---
--- * VoiceXML stuff
---
-
-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
-
-field :: String -> [(String,String)] -> [XML] -> XML
-field name attrs = Tag "field" ([("name",name)]++attrs)
-
-subdialog :: String -> [(String,String)] -> [XML] -> XML
-subdialog name attrs = Tag "subdialog" ([("name",name)]++attrs)
-
-filled :: [(String,String)] -> [XML] -> XML
-filled = Tag "filled"
-
-vxmlGrammar :: String -> XML
-vxmlGrammar uri = ETag "grammar" [("src",uri)]
-
-prompt :: [XML] -> XML
-prompt = Tag "prompt" []
-
-promptString :: String -> XML
-promptString p = prompt [Data p]
-
-reprompt :: XML
-reprompt = ETag "reprompt" []
-
-assign :: String -> String -> XML
-assign n e = ETag "assign" [("name",n),("expr",e)]
-
-value :: String -> XML
-value expr = ETag "value" [("expr",expr)]
-
-if_ :: String -> [XML] -> XML
-if_ c b = if_else c b []
-
-if_else :: String -> [XML] -> [XML] -> XML
-if_else c t f = cond [(c,t)] f
-
-cond :: [(String,[XML])] -> [XML] -> XML
-cond ((c,b):rest) els = Tag "if" [("cond",c)] (b ++ es)
-  where es = [Tag "elseif" [("cond",c')] b' | (c',b') <- rest] 
-             ++ if null els then [] else (Tag "else" [] []:els)
-
-goto_item :: String -> XML
-goto_item nextitem = ETag "goto" [("nextitem",nextitem)]
-
-return_ :: [String] -> XML
-return_ names = ETag "return" [("namelist", unwords names)]
-
-block :: [XML] -> XML
-block = Tag "block" []
-
-blockCond :: String -> [XML] -> XML
-blockCond cond = Tag "block" [("cond", cond)]
-
-throw :: String -> String -> XML
-throw event msg = Tag "throw" [("event",event),("message",msg)] []
-
-nomatch :: [XML] -> XML
-nomatch = Tag "nomatch" []
-
-help :: [XML] -> XML
-help = Tag "help" []
-
-param :: String -> String -> XML
-param name expr = ETag "param" [("name",name),("expr",expr)]
-
-var :: String -> Maybe String -> XML
-var name expr = ETag "var" ([("name",name)]++e)
-  where e = maybe [] ((:[]) . (,) "expr") expr
-
-script :: String -> XML
-script s = Tag "script" [] [CData s]
-
-scriptURI :: String -> XML
-scriptURI uri = Tag "script" [("uri", uri)] []
-
---
--- * ECMAScript stuff
---
-
-string :: String -> String
-string s = "'" ++ concatMap esc s ++ "'"
-  where esc '\'' = "\\'"
-        esc c    = [c]
-
-{-
---
--- * List stuff
---
-
-isListCat :: (VIdent, [(VIdent, [VIdent])]) -> Bool
-isListCat (cat,rules) = "List" `isPrefixOf` prIdent cat && length rules == 2
-		    && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
-    where c = drop 4 (prIdent cat)
-	  fs = map (prIdent . fst) rules
-
-isBaseFun :: VIdent -> Bool
-isBaseFun f = "Base" `isPrefixOf` prIdent f
-
-isConsFun :: VIdent -> Bool
-isConsFun f = "Cons" `isPrefixOf` prIdent f
-
-baseSize :: (VIdent, [(VIdent, [VIdent])]) -> Int
-baseSize (_,rules) = length bs
-    where Just (_,bs) = find (isBaseFun . fst) rules
--}