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, Text.GenXML.GenPrint
import Control.GenBimap

ggen{|XMLDocWithString|} st =
	[! docWithHexCharacterReferences
	, docWithDecCharacterReferences
	: (\(doc, withWhite) -> {document = doc, stringRepresentation = if withWhite (toString doc+++" ") (toString doc)})
		<$> ggen{|*|} st
	]
where
	// This cannot be generated by `toString`, as UTF-8 characters are included in the string representation unencoded.
	docWithHexCharacterReferences =
		{ document = testDocWith [XMLAttr (uname "a") "ó ¾"] [XMLText "Test"]
		, stringRepresentation =
			"<?xml version=\"1.0}\" standalone=\"no\"?><root a=\"&#xc3;&#xb3; &#xc2bE;\">&#x54;&#x65;&#x73;&#x74;</root>"
		}

	docWithDecCharacterReferences =
		{ document = testDocWith [XMLAttr (uname "a") "ó"] [XMLText "Test"]
		, stringRepresentation =
			"<?xml version=\"1.0}\" standalone=\"no\"?><root a=\"&#195;&#179;\">&#84;&#101;&#115;&#116;</root>"
		}

// TODO: Generate URIs for namespaces, instead of using names.
ggen{|XMLDoc|} st =
	withMergedConsecutiveText <$>
		[! docWithNamedCharacterEntityReference
		:	[! XMLDoc
				(unNameString <$> defaultNamespace)
				(bifmap unNameString unNameString <$> namespaces)
				(XMLElem rootName rootAttrs rootChildren)
			\\ (defaultNamespace, namespaces, rootName, rootAttrs, rootChildren) <|- ggen{|*|} st
			]
		]
where
	docWithNamedCharacterEntityReference = testDocWith [XMLAttr (uname "attr") "< >\" '&"] [XMLText "\"& <>\""]

testDocWith :: ![XMLAttr] ![XMLNode] -> XMLDoc
testDocWith attrs content = XMLDoc ?None [] (XMLElem (uname "root") attrs content)

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 <> ""]

withMergedConsecutiveText :: !XMLDoc -> XMLDoc
withMergedConsecutiveText (XMLDoc defaultNamespace namespaces rootNode) =
	XMLDoc defaultNamespace namespaces $ nodeWithMergedConsecutiveText rootNode
where
	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]

derive ggen    XMLNode, XMLAttr
derive genShow XMLDocWithString, XMLDoc, XMLQName, XMLNode, XMLAttr
derive gPrint  XMLDocWithString
