Verified Commit 3af7dacb authored by Steffen Michels's avatar Steffen Michels Committed by Camil Staps

add support for XML CDATA & named character entity references

parent e0ddb50e
Pipeline #29738 passed with stage
in 2 minutes and 58 seconds
......@@ -14,7 +14,7 @@ test-nightly:
image: "camilstaps/clean:nightly"
script:
- COCLPATH=./compiler make -C tests/linux64 run
- cleantest -r testproperties --options '-IL;Dynamics;-d;src/libraries/OS-Independent;-P;OutputTestEvents;-T;Tests 100000;-T;MaxStringLength 500;-C;-h;-C;100m;-r' --junit junit.xml
- cleantest -r testproperties --options '-IL;Dynamics;-d;src/libraries/OS-Independent;-P;OutputTestEvents;-T;Tests 100000;-T;MaxStringLength 500;-T;Bent;-C;-h;-C;100m;-r' --junit junit.xml
artifacts:
paths:
- junit.xml
......
definition module Data.Error
from StdOverloaded import class ==
from Data.Functor import class Functor
from Control.Monad import class Monad
from Control.Applicative import class pure, class <*>, class Applicative
......@@ -23,7 +24,7 @@ instance Functor (MaybeError a)
instance pure (MaybeError a)
instance <*> (MaybeError a)
instance Monad (MaybeError a)
instance == (MaybeError a b) | == a & == b
derive gEq MaybeError
/**
......
......@@ -23,6 +23,14 @@ instance Monad (MaybeError e) where
bind (Error l) _ = Error l
bind (Ok r) k = k r
instance == (MaybeError a b) | == a & == b where
== (Ok x) y = case y of
Ok y = x == y
_ = False
== (Error x) y = case y of
Error y = x == y
_ = False
derive gEq MaybeError
isOk :: !(MaybeError a b) -> Bool
......
definition module Data.Maybe.Gast
from Data.Maybe import :: Maybe
from Gast import generic ggen, generic genShow, :: GenState
derive genShow Maybe
derive ggen Maybe
implementation module Data.Maybe.Gast
import Gast
import Data.Maybe
import Control.GenBimap
derive genShow Maybe
derive ggen Maybe
definition module Data.Maybe.GenPrint
from Data.Maybe import :: Maybe
from Text.GenPrint import generic gPrint, class PrintOutput, :: PrintState
derive gPrint Maybe
implementation module Data.Maybe.GenPrint
import Data.Maybe
import Text.GenPrint
derive gPrint Maybe
definition module Text.GenXML
/**
* This module provides data types for easy construction of XML documents and
* a generic printer/parser.
* This module provides data types for easy construction of XML documents and
* a generic conversion of Clean values to XML.
*
* @property-bootstrap
* import StdEnv, Data.Error, Data.Func, Text.GenXML.Gast, Text.GenXML.GenPrint
*
* derive genShow MaybeError
* derive gPrint MaybeError
* derive class Gast Maybe
*
* withMergedConsecutiveText :: !XMLDoc -> XMLDoc
* withMergedConsecutiveText (XMLDoc defaultNamespace namespaces rootNode) =
* XMLDoc defaultNamespace namespaces $ nodeWithMergedConsecutiveText rootNode
*
* nodeWithMergedConsecutiveText :: !XMLNode -> XMLNode
* nodeWithMergedConsecutiveText (XMLElem name attrs nodes) =
* XMLElem name attrs $ nodesWithMergedConsecutiveText nodes
* nodeWithMergedConsecutiveText node = node
*
* nodesWithMergedConsecutiveText :: ![XMLNode] -> [XMLNode]
* nodesWithMergedConsecutiveText [] = []
* nodesWithMergedConsecutiveText [XMLText text1, XMLText text2: rest] =
* nodesWithMergedConsecutiveText [XMLText $ text1 +++ text2: rest]
* nodesWithMergedConsecutiveText [node: rest] =
* [nodeWithMergedConsecutiveText node: nodesWithMergedConsecutiveText rest]
*/
import StdOverloaded, StdGeneric, Data.Either
from Data.Maybe import :: Maybe
from Data.Error import :: MaybeErrorString, :: MaybeError
from Data.GenEq import generic gEq
:: XMLDoc = XMLDoc !(Maybe XMLURI) ![(XMLNamespacePrefix,XMLURI)] !XMLNode
:: XMLNode = XMLElem !XMLQName ![XMLAttr] ![XMLNode]
| XMLText !String
instance == XMLDoc
derive gEq XMLDoc
/**
* A node in an XML document.
*/
:: XMLNode
= XMLElem !XMLQName ![XMLAttr] ![XMLNode] //* An element
| XMLText !String //* Character data
| XMLCData !String //* A CDATA section
derive gEq XMLNode
:: XMLAttr = XMLAttr !XMLQName !String
derive gEq XMLAttr
:: XMLQName = XMLQName !(Maybe XMLNamespacePrefix) !XMLName
derive gEq XMLQName
:: XMLNamespacePrefix :== String
:: XMLURI :== String
:: XMLName :== String
/**
* Create an XMLQName containing an unqualified name from a String
* Create an XMLQName containing an unqualified name from a String.
*
* @param Unqualified name
* @return XMLQName containing the unqualified name
* @result XMLQName containing the unqualified name
*/
uname :: !String -> XMLQName
/**
* Create an XMLQName containing a qualified name from a String
* Create an XMLQName containing a qualified name from a String.
*
* @param Qualified name
* @return XMLQName containing the qualified name
* @result XMLQName containing the qualified name
*/
qname :: !XMLNamespacePrefix !String -> XMLQName
instance toString XMLDoc
/**
* The XML document corresponding to a string.
*
* @property correctness: A.doc :: XMLDoc:
* fromString (toString doc) =.= typedOk (withMergedConsecutiveText doc)
* where
* typedOk :: !XMLDoc -> MaybeErrorString XMLDoc
* typedOk doc = Ok doc
*/
instance fromString (MaybeErrorString XMLDoc)
// generic printer
......@@ -45,6 +95,7 @@ toXML :: !a -> XMLDoc | XMLEncode{|*|} a
toXMLString :: !a -> String | XMLEncode{|*|} a
:: XMLEncodeResult
generic XMLEncode a :: !a -> XMLEncodeResult
// special types for adding attributes to XML data
......
definition module Text.GenXML.Gast
from Gast import generic ggen, generic genShow, :: GenState
from Text.GenXML import :: XMLDoc, :: XMLNode, :: XMLAttr, :: XMLQName
derive ggen XMLDoc, XMLQName, XMLNode, XMLAttr
derive genShow XMLDoc, XMLQName, XMLNode, XMLAttr
implementation module Text.GenXML.Gast
import StdEnv
import Gast
import Data.Func, Data.Functor, Data.Maybe, Data.Maybe.Gast, Data.List, Data.Bifunctor, Data.Tuple
import Text.GenXML
import Control.GenBimap
derive genShow XMLDoc, XMLQName, XMLNode, XMLAttr
derive ggen XMLNode, XMLAttr
// TODO: Generate URIs for namespaces, instead of using names.
ggen{|XMLDoc|} st =
[ XMLDoc
(unNameString <$> defaultNamespace)
(bifmap unNameString unNameString <$> namespaces)
(XMLElem rootName rootAttrs rootChildren)
\\ (defaultNamespace, namespaces, rootName, rootAttrs, rootChildren) <- ggen{|*|} st
]
ggen{|XMLQName|} st = [XMLQName (unNameString <$> namespace) (unNameString name) \\ (namespace, name) <- ggen{|*|} st]
:: NameString =: NameString String
unNameString :: !NameString -> String
unNameString (NameString str) = str
// TODO: Also include capital letters and other valid characters.
ggen{|NameString|} _ = [NameString str \\ str <- ggenString 7 4.0 97 122 aStream | str <> ""]
definition module Text.GenXML.GenPrint
from Text.GenXML import :: XMLDoc, :: XMLNode, :: XMLAttr, :: XMLQName
from Text.GenPrint import generic gPrint, class PrintOutput, :: PrintState
derive gPrint XMLDoc, XMLQName, XMLNode, XMLAttr
implementation module Text.GenXML.GenPrint
import Data.Maybe.GenPrint
import Text.GenXML, Text.GenPrint
derive gPrint XMLDoc, XMLQName, XMLNode, XMLAttr
......@@ -13,7 +13,8 @@ CLMLIBS:=\
-I ../../src/libraries/Platform-x86\
-IL Dynamics\
-IL GraphCopy\
-IL TCPIP
-IL TCPIP\
-IL Gast
COCLPATH?=../../../compiler
COCLLIBS:=\
......@@ -32,6 +33,7 @@ $(filter-out checktest commentstest tartest snappytest,$(BINARIES)): .FORCE
$(CLM) $(CLMLIBS) -PABC StdMaybe
$(CLM) $(CLMLIBS) -PABC -dynamics _SystemDynamic
$(CLM) $(CLMLIBS) -PABC TCPIP
$(CLM) $(CLMLIBS) -PABC Gast
$(CLM) $(CLMLIBS) $(CLMFLAGS) $@ -o $@
$(filter-out run_tartest,$(RUN_BINARIES)): run_%: %
......
......@@ -126,6 +126,8 @@ import qualified Data.MapCollection
import qualified Data.Matrix
import qualified Data.Maybe
import qualified Data.Maybe.Ord
import qualified Data.Maybe.Gast
import qualified Data.Maybe.GenPrint
import qualified Data.Monoid
import qualified Data.NGramIndex
import qualified Data.OrdList
......@@ -200,6 +202,8 @@ import qualified Text.GenJSON
import qualified Text.GenParse
import qualified Text.GenPrint
import qualified Text.GenXML
import qualified Text.GenXML.Gast
import qualified Text.GenXML.GenPrint
import qualified Text.HTML
import qualified Text.HTML.GenJSON
import qualified Text.LaTeX
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment