mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-11 12:12:51 -06:00
Added ETag constructor to GF.Data.XML.XML since not all tags can use the empty shorthand.
This commit is contained in:
@@ -12,7 +12,7 @@ module GF.Data.XML (XML(..), Attr, comments, showXMLDoc, showsXMLDoc, showsXML,
|
|||||||
|
|
||||||
import GF.Data.Utilities
|
import GF.Data.Utilities
|
||||||
|
|
||||||
data XML = Data String | CData String | Tag String [Attr] [XML] | Comment String | Empty
|
data XML = Data String | CData String | Tag String [Attr] [XML] | ETag String [Attr] | Comment String | Empty
|
||||||
deriving (Ord,Eq,Show)
|
deriving (Ord,Eq,Show)
|
||||||
|
|
||||||
type Attr = (String,String)
|
type Attr = (String,String)
|
||||||
@@ -30,7 +30,7 @@ showsXMLDoc xml = showString header . showsXML xml
|
|||||||
showsXML :: XML -> ShowS
|
showsXML :: XML -> ShowS
|
||||||
showsXML (Data s) = showString s
|
showsXML (Data s) = showString s
|
||||||
showsXML (CData s) = showString "<![CDATA[" . showString s .showString "]]>"
|
showsXML (CData s) = showString "<![CDATA[" . showString s .showString "]]>"
|
||||||
showsXML (Tag t as []) = showChar '<' . showString t . showsAttrs as . showString "/>"
|
showsXML (ETag t as) = showChar '<' . showString t . showsAttrs as . showString "/>"
|
||||||
showsXML (Tag t as cs) =
|
showsXML (Tag t as cs) =
|
||||||
showChar '<' . showString t . showsAttrs as . showChar '>'
|
showChar '<' . showString t . showsAttrs as . showChar '>'
|
||||||
. concatS (map showsXML cs) . showString "</" . showString t . showChar '>'
|
. concatS (map showsXML cs) . showString "</" . showString t . showChar '>'
|
||||||
|
|||||||
@@ -219,7 +219,7 @@ filled :: [(String,String)] -> [XML] -> XML
|
|||||||
filled = Tag "filled"
|
filled = Tag "filled"
|
||||||
|
|
||||||
vxmlGrammar :: String -> XML
|
vxmlGrammar :: String -> XML
|
||||||
vxmlGrammar uri = Tag "grammar" [("src",uri)] []
|
vxmlGrammar uri = ETag "grammar" [("src",uri)]
|
||||||
|
|
||||||
prompt :: [XML] -> XML
|
prompt :: [XML] -> XML
|
||||||
prompt = Tag "prompt" []
|
prompt = Tag "prompt" []
|
||||||
@@ -228,13 +228,13 @@ promptString :: String -> XML
|
|||||||
promptString p = prompt [Data p]
|
promptString p = prompt [Data p]
|
||||||
|
|
||||||
reprompt :: XML
|
reprompt :: XML
|
||||||
reprompt = Tag "reprompt" [] []
|
reprompt = ETag "reprompt" []
|
||||||
|
|
||||||
assign :: String -> String -> XML
|
assign :: String -> String -> XML
|
||||||
assign n e = Tag "assign" [("name",n),("expr",e)] []
|
assign n e = ETag "assign" [("name",n),("expr",e)]
|
||||||
|
|
||||||
value :: String -> XML
|
value :: String -> XML
|
||||||
value expr = Tag "value" [("expr",expr)] []
|
value expr = ETag "value" [("expr",expr)]
|
||||||
|
|
||||||
if_ :: String -> [XML] -> XML
|
if_ :: String -> [XML] -> XML
|
||||||
if_ c b = if_else c b []
|
if_ c b = if_else c b []
|
||||||
@@ -248,10 +248,10 @@ cond ((c,b):rest) els = Tag "if" [("cond",c)] (b ++ es)
|
|||||||
++ if null els then [] else (Tag "else" [] []:els)
|
++ if null els then [] else (Tag "else" [] []:els)
|
||||||
|
|
||||||
goto_item :: String -> XML
|
goto_item :: String -> XML
|
||||||
goto_item nextitem = Tag "goto" [("nextitem",nextitem)] []
|
goto_item nextitem = ETag "goto" [("nextitem",nextitem)]
|
||||||
|
|
||||||
return_ :: [String] -> XML
|
return_ :: [String] -> XML
|
||||||
return_ names = Tag "return" [("namelist", unwords names)] []
|
return_ names = ETag "return" [("namelist", unwords names)]
|
||||||
|
|
||||||
block :: [XML] -> XML
|
block :: [XML] -> XML
|
||||||
block = Tag "block" []
|
block = Tag "block" []
|
||||||
@@ -269,10 +269,10 @@ help :: [XML] -> XML
|
|||||||
help = Tag "help" []
|
help = Tag "help" []
|
||||||
|
|
||||||
param :: String -> String -> XML
|
param :: String -> String -> XML
|
||||||
param name expr = Tag "param" [("name",name),("expr",expr)] []
|
param name expr = ETag "param" [("name",name),("expr",expr)]
|
||||||
|
|
||||||
var :: String -> Maybe String -> XML
|
var :: String -> Maybe String -> XML
|
||||||
var name expr = Tag "var" ([("name",name)]++e) []
|
var name expr = ETag "var" ([("name",name)]++e)
|
||||||
where e = maybe [] ((:[]) . (,) "expr") expr
|
where e = maybe [] ((:[]) . (,) "expr") expr
|
||||||
|
|
||||||
script :: String -> XML
|
script :: String -> XML
|
||||||
|
|||||||
@@ -61,7 +61,7 @@ prSrgsXml sisr probs srg@(SRG{grammarName=name,startCat=start,
|
|||||||
prRhs rhss = [oneOf (map (mkProd sisr probs) rhss)]
|
prRhs rhss = [oneOf (map (mkProd sisr probs) rhss)]
|
||||||
-- externally visible rules for each of the GF categories
|
-- externally visible rules for each of the GF categories
|
||||||
topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg]
|
topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg]
|
||||||
where it i c = Tag "item" [] [Tag "ruleref" [("uri","#" ++ c)] [],
|
where it i c = Tag "item" [] [ETag "ruleref" [("uri","#" ++ c)],
|
||||||
tag sisr (topCatSISR c)]
|
tag sisr (topCatSISR c)]
|
||||||
topRule i is = Tag "rule" [("id",catFormId i),("scope","public")] is
|
topRule i is = Tag "rule" [("id",catFormId i),("scope","public")] is
|
||||||
|
|
||||||
@@ -98,7 +98,7 @@ mkItem sisr cn ss = map (symItem sisr cn) ss
|
|||||||
|
|
||||||
symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
|
symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
|
||||||
symItem sisr cn (Cat n@(c,_)) =
|
symItem sisr cn (Cat n@(c,_)) =
|
||||||
Tag "item" [] $ [Tag "ruleref" [("uri","#" ++ c)] [], tag sisr (catSISR cn n)]
|
Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)], tag sisr (catSISR cn n)]
|
||||||
symItem _ _ (Tok t) = Tag "item" [] [Data (showToken t)]
|
symItem _ _ (Tok t) = Tag "item" [] [Data (showToken t)]
|
||||||
|
|
||||||
tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> XML
|
tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> XML
|
||||||
|
|||||||
Reference in New Issue
Block a user