{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-- ------------------------------------------------------------{- |
Module : Text.XML.HXT.XPath.XPathFct
Copyright : Copyright (C) 2008 Uwe Schmidt
License : MIT
Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
Stability : experimental
Portability: portable
The module contains the core-functions of the XPath function library.
All functions are implemented as XFct. Each XFct contains the evaluation context,
the variable environment and the function arguments.
-}-- ------------------------------------------------------------moduleText.XML.HXT.XPath.XPathFct(XFct,evalFct,toXValue,xnumber,xboolean,xstring,getConvFct,stringValue-- , remDups,isNotInNodeList{-
, createDocumentOrder
, createDocumentOrderReverse
-},getVarTab,getKeyTab)whereimportText.XML.HXT.XPath.XPathDataTypesimportText.XML.HXT.XPath.XPathParser(parseNumber)importText.XML.HXT.XPath.XPathArithmetic(xPathAdd)importControl.Arrow((>>>),(<+>))importControl.Arrow.ArrowList(constA)importControl.Arrow.ArrowIf(ifA)importControl.Arrow.ArrowTree(deep)importControl.Arrow.ListArrow(LA,runLA)importText.XML.HXT.Arrow.XmlArrowimportText.XML.HXT.Arrow.ReadDocument(readDocument)importText.XML.HXT.Arrow.XmlState(runX,withValidate,no)importText.XML.HXT.DOM.InterfaceimportqualifiedText.XML.HXT.DOM.XmlNodeasXNimportSystem.IO.Unsafe(unsafePerformIO)importData.Char(isAscii,isUpper,isLower,isDigit,ord)importData.Maybe-- ------------------------------------------------------------------------------- added by Tim Walkenhorst to fix Pos0 vs. Float 0.0 problems...int2XPNumber::Int->XPNumberint2XPNumber0=Pos0int2XPNumberi=Float$fromIntegrali-- |-- Type signature for all functions which can be used in the XPath module.typeXFct=(Context->Env->[XPathValue]->XPathValue)-- |-- All functions are stored in a function table.typeFctTable=[(FctName,FctTableElem)]-- |-- Each table entry consists of the function and the expected function arguments.typeFctTableElem=(XFct,CheckArgCount)-- |-- Tests whether the number of current function arguments is correcttypeCheckArgCount=([XPathValue]->Bool)-- -----------------------------------------------------------------------------zero,zeroOrOne,one,two,twoOrM,twoOrThree,three::CheckArgCountzeroex=lengthex==0zeroOrOneex=lengthex==0||lengthex==1oneex=lengthex==1twoex=lengthex==2twoOrMex=lengthex>=2twoOrThreeex=lengthex==2||lengthex==3threeex=lengthex==3-- ------------------------------------------------------------------------------- |-- The core-functions libraryfctTable::FctTablefctTable=[("last",(xlast,zero)),-- nodeset functions("position",(xposition,zero)),("count",(xcount,one)),("id",(xid,one)),("local-name",(xlocalName,zeroOrOne)),("namespace-uri",(xnamespaceUri,zeroOrOne)),("name",(xname,zeroOrOne)),("string",(xstring,zeroOrOne)),-- string functions("concat",(xconcat,twoOrM)),("starts-with",(xstartsWith,two)),("contains",(xcontains,two)),("substring-before",(xsubstringBefore,two)),("substring-after",(xsubstringAfter,two)),("substring",(xsubstring,twoOrThree)),("string-length",(xstringLength,zeroOrOne)),("normalize-space",(xnormalizeSpace,zeroOrOne)),("translate",(xtranslate,three)),("boolean",(xboolean,one)),-- boolean functions("not",(xnot,one)),("true",(xtrue,zero)),("false",(xfalse,zero)),("lang",(xlang,one)),("number",(xnumber,zeroOrOne)),-- number functions("sum",(xsum,one)),("floor",(xfloor,one)),("ceiling",(xceiling,one)),("round",(xround,one)),("key",(xkey,two)),("format-number",(xformatNumber,twoOrThree)),("document",(xdocument,one)),-- extension functions for xslt 1.0("generate-id",(xgenerateId,zeroOrOne))]-- ------------------------------------------------------------------------------- some helper functions-- |-- Returns the table of keys, needed by xslt, from the environmentgetKeyTab::Env->KeyTabgetKeyTab(_,keyTab)=keyTab-- ------------------------------------------------------------------------------- |-- Returns the table of variables from the environmentgetVarTab::Env->VarTabgetVarTab(varTab,_)=varTab-- ------------------------------------------------------------------------------- |-- Returns the conversion function for the XPath results: string, boolean and number-- A nodeset can not be converted.getConvFct::XPathValue->MaybeXFctgetConvFct(XPVNumber_)=JustxnumbergetConvFct(XPVString_)=JustxstringgetConvFct(XPVBool_)=JustxbooleangetConvFct_=Nothing-- ------------------------------------------------------------------------------- |-- Check whether a node is not a part of a node list. Needed to implement matching & testing in xslt.isNotInNodeList::NavXmlTree->[NavXmlTree]->BoolisNotInNodeListnxs'=nodeID'n`notElem`mapnodeID'xs'-- ------------------------------------------------------------------------------- |-- calculate an ID for a NODE---- - returns : a list of numbers, one number for each level of the tree-- Tim Walkenhorst:-- - Attributes are identified by their QName (they do not have previous siblings)-- - Elements are identified by their relative position (# of previous siblings)dataIdPathStep=IdRootString|IdPosInt|IdAttrQNamederiving(Show,Eq)nodeID::MaybeNavXmlTree->[IdPathStep]nodeID=maybe[]nodeID'nodeID'::NavXmlTree->[IdPathStep]nodeID't@(NT(NTree(XAttrqn)_)_ix___)=IdAttrqn:nodeID(upNTt)nodeID't@(NTnodeix___)|XN.isRootnode=return$IdRoot(getRootIdnode)|otherwise=IdPosix:nodeID(upNTt)wheregetRootId=concat.runLA(getAttrValue"rootId")-- ------------------------------------------------------------------------------- |-- Evaluates a function.-- Calculation of the function value is done by looking up the function name in the function table,-- check the number of arguments and calculate the funtion, if no-- argument evaluation returns an error.---- - returns : the function value as 'XPathValue'evalFct::FctName->Env->Context->[XPathValue]->XPathValueevalFctnameenvcontargs=case(lookupnamefctTable)ofNothing->XPVError("Call to undefined function "++name)Just(fct,checkArgCount)->ifnot(checkArgCountargs)thenXPVError("Call to function "++name++" with wrong arguments")elsecase(checkArgErrorsargs)ofJuste->eNothing->fctcontenvargswherecheckArgErrors[]=NothingcheckArgErrors((XPVErrorr):_)=Just(XPVErrorr)checkArgErrors(_:xs)=checkArgErrorsxs-- |-- Converts a list of different 'XPathValue' types in a list of one 'XPathValue' type.---- * 1.parameter fct : the conversion function--toXValue::XFct->Context->Env->[XPathValue]->[XPathValue]toXValuefctcenvargs=[fctcenv[x]|x<-args]-- ------------------------------------------------------------------------------- core-funktions library-- nodeset functions-- |-- number last(): returns a number equal to the context size from the expression evaluation contextxlast::XFctxlast(_,len,_)__=XPVNumber$int2XPNumberlen-- ------------------------------------------------------------------------------- |-- number position(): returns a number equal to the context position from the expression evaluation contextxposition::XFctxposition(pos,_,_)__=XPVNumber$int2XPNumberpos-- ------------------------------------------------------------------------------- |-- number count(node-set): returns the number of nodes in the argument node-setxcount::XFctxcount__[XPVNodens]=XPVNumber.int2XPNumber.cardNodeSet$nsxcount___=XPVError"Call to function count with wrong arguments"-- ------------------------------------------------------------------------------- |-- node-set id(object): selects elements by their unique IDxid::XFctxid(_,_,cn)env[XPVNodens]=isInId(getIdsenv)(strValuesns)[cn]wherestrValues=map((\(XPVStringstr)->str).stringValue).fromNodeSetxidc@(_,_,cn)envarg=isInId(getIdsenv)((\(XPVStrings)->wordss)(xstringcenvarg))[cn]-- ------------------------------------------------------------------------------- |-- returns all IDs from the variable environment as a list of strings.-- the IDs are stored in the variable: idAttrgetIds::Env->[String]getIdsenv=words$-- hier muss noch auf prefix getestet werden(\(XPVStringstr)->str).fromJust$lookup("","idAttr")$getVarTabenv-- -----------------------------------------------------------------------------isInId::[String]->[String]->NavXmlTrees->XPathValueisInIdidsstr=XPVNode.toNodeSet.concatMap(filterNSidsstr.descendantOrSelfAxis)-- -----------------------------------------------------------------------------filterNS::[String]->[String]->NavXmlTrees->NavXmlTreesfilterNSidsstrns=[n|n@(NTa____)<-ns,or$map(idInIdListastr)ids]whereidInIdList::XmlTree->[String]->String->BoolidInIdListalstr'b=(getValuebal)`elem`str'-- ------------------------------------------------------------------------------- |-- string local-name(node-set?):-- returns the local part of the expanded-name of the node in the argument node-set-- that is first in document order.-- If the argument node-set is empty or the first node has no expanded-name, an empty string is returned.-- If the argument is omitted, it defaults to a node-set with the context node as its only member-- Bugfix: name(\/) is "" not "\/"!xlocalName::XFctxlocalName(_,_,cn)_[]=XPVString(xpLocalPartOf.subtreeNT$cn)xlocalName__[XPVNodens]|nullNodeSetns=XPVString""|otherwise=XPVString(xpLocalPartOf.subtreeNT.headNodeSet$ns)xlocalName___=XPVError"Call to function local-name with wrong arguments"-- ------------------------------------------------------------------------------- |-- string namespace-uri(node-set?):-- returns the namespace URI of the expanded-name of the node in the argument node-set-- that is first in document order.-- If the argument node-set is empty, the first node has no expanded-name,-- or the namespace URI of the expanded-name-- is null, an empty string is returned. If the argument is omitted,-- it defaults to a node-set with the context node as its only memberxnamespaceUri::XFctxnamespaceUri(_,_,cn)_[]=XPVString(xpNamespaceOf.subtreeNT$cn)xnamespaceUri__[XPVNodens]|nullNodeSetns=XPVString""|otherwise=XPVString(xpNamespaceOf.subtreeNT.headNodeSet$ns)xnamespaceUri___=XPVError"Call to function namespace-uri with wrong arguments"-- ------------------------------------------------------------------------------- |-- string name(node-set?):-- returns a string containing a QName representing the expanded-name of the node-- in the argument node-set-- that is first in document order. If the argument node-set is empty or the first-- node has no expanded-name,-- an empty string is returned. If the argument it omitted, it defaults to a node-set-- with the context node as its only member.-- Tim Walkenhorst:-- Bugfix: name(\/) is "" not "\/"!xname::XFctxname(_,_,cn)_[]=XPVString(xpNameOf.subtreeNT$cn)xname__[XPVNodens]|nullNodeSetns=XPVString""|otherwise=XPVString(xpNameOf.subtreeNT.headNodeSet$ns)xname___=XPVError"Call to function name with wrong arguments"-- -------------------------------------------------------------- string functions-- |-- some helper functionsgetFirstPos::String->String->IntgetFirstPosssub=if(getFirstPos'ssub)>lengthsthen-1elsegetFirstPos'ssub-- -----------------------------------------------------------------------------getFirstPos'::String->String->IntgetFirstPos'[]_=2getFirstPos'(x:xs)sub=ifstrStartsWith(x:xs)subthen0else1+getFirstPos'xssub-- -----------------------------------------------------------------------------strStartsWith::String->String->BoolstrStartsWithab=take(lengthb)a==b-- ------------------------------------------------------------------------------- |-- Returns the string-value of a node,-- the value of a namespace node is not supportedstringValue::NavXmlTree->XPathValuestringValue=XPVString.xpTextOf.self{-
textFilter
= getXCmt `orElse`
-- getXNamespace `orElse`
multi isXText
-- = (isXTag `guards` multi isXText) `orElse`
-- (isXPi `guards` multi isXText) `orElse`
-- (isXAttr `guards` multi isXText) `orElse`
-- (isXText `guards` multi isXText) `orElse`
-- getXCmt
-}-- ------------------------------------------------------------------------------- |-- string string(object?): converts an object to a stringxstring::XFctxstring__[XPVNodens]|nullNodeSetns=XPVString""|otherwise=stringValue.headNodeSet$nsxstring(_,_,cn)_[]=stringValuecnxstring__[XPVNumber(Floata)]|a==(fromInteger$rounda)=XPVString(show((rounda)::Integer))|otherwise=XPVString(showa)xstring__[XPVNumbers]=XPVString(shows)xstring__[XPVBoolTrue]=XPVString"true"xstring__[XPVBoolFalse]=XPVString"false"xstring__[XPVStrings]=XPVStringsxstring__[XPVErrore]=XPVErrorexstring___=XPVError"Call to xstring with a wrong argument"-- ------------------------------------------------------------------------------- |-- string concat(string, string, string*): returns the concatenation of its argumentsxconcat::XFctxconcatcenvargs=XPVString(foldr(\(XPVStrings)->(s++))""(toXValuexstringcenvargs))-- ------------------------------------------------------------------------------- |-- boolean starts-with(string, string):-- returns true if the first argument string starts-- with the second argument string, and otherwise returns falsexstartsWith::XFctxstartsWithcenvargs=XPVBool$(\((XPVStringa):[XPVStringb])->strStartsWithab)$toXValuexstringcenvargs-- ------------------------------------------------------------------------------- |-- boolean contains(string, string):-- returns true if the first argument string contains the second argument string,-- and otherwise returns falsexcontains::XFctxcontainscenvargs=XPVBool$(\((XPVStrings):[XPVStringsub])->getFirstPosssub/=-1)$toXValuexstringcenvargs-- ------------------------------------------------------------------------------- |-- string substring-before(string, string):-- returns the substring of the first argument string that precedes the first occurrence of-- the second argument string-- in the first argument string, or the empty string if the first argument string does not-- contain the second argument stringxsubstringBefore::XFctxsubstringBeforecenvargs=xsubstringBefore'cenv(toXValuexstringcenvargs)xsubstringBefore'::XFctxsubstringBefore'__((XPVString_):[XPVString[]])=XPVString""xsubstringBefore'__((XPVStrings):[XPVStringsub])=XPVString(take(getFirstPosssub)s)xsubstringBefore'___=XPVError"Call to xsubstringBefore' with a wrong argument"-- ------------------------------------------------------------------------------- |-- string substring-after(string, string):-- returns the substring of the first argument string that follows the first occurrence of-- the second argument string-- in the first argument string, or the empty string if the first argument string does not-- contain the second argument stringxsubstringAfter::XFctxsubstringAftercenvargs=xsubstringAfter'cenv(toXValuexstringcenvargs)xsubstringAfter'::XFctxsubstringAfter'__((XPVStrings):[XPVString[]])=XPVStringsxsubstringAfter'__((XPVStrings):[XPVStringsub])=ifgetFirstPosssub==-1then(XPVString"")elseXPVString(drop((getFirstPosssub)+lengthsub)s)xsubstringAfter'___=XPVError"Call to xsubstringAfter' with a wrong argument"-- ------------------------------------------------------------------------------- |-- string substring(string, number, number?):-- returns the substring of the first argument starting at the position specified-- in the second argument-- with length specified in the third argument. If the third argument is not specified,-- it returns the substring-- starting at the position specified in the second argument and continuing to the end of the string.xsubstring::XFctxsubstringcenv(x:xs)=xsubstring'cenv((toXValuexstringcenv[x])++(toXValuexnumbercenvxs))xsubstring___=XPVError"Call to xsubstring with a wrong argument"xsubstring'::XFctxsubstring'cenv((XPVStrings):start:[])=casexroundcenv[start]ofXPVNumberNaN->XPVString""XPVNumberPosInf->XPVString""XPVNumber(Floatf)->XPVString(drop((roundf)-1)s)XPVNumber_->XPVStrings_->XPVError"Call to xsubstring' with a wrong argument"xsubstring'cenv((XPVStrings):start:[end])=casexPathAddPlus(xroundcenv[start])(xroundcenv[end])ofXPVNumber(Floatf)->xsubstring'cenv((XPVString(take((roundf)-1)s)):[start])XPVNumberPosInf->xsubstring'cenv((XPVStrings):[start])XPVNumber_->XPVString""_->XPVError"Call to xsubstring' with a wrong argument"xsubstring'___=XPVError"Call to xsubstring' with a wrong argument"-- ------------------------------------------------------------------------------- |-- number string-length(string?):-- returns the number of characters in the string. If the argument is omitted,-- it defaults to the context node-- converted to a string, in other words the string-value of the context node.xstringLength::XFctxstringLengthc@(_,_,cn)env[]=XPVNumber(Float(fromIntegral$lengths))whereXPVStrings=xstringcenv[XPVNode$singletonNodeSetcn]xstringLengthcenvargs=XPVNumber$(\[XPVStrings]->int2XPNumber$lengths)$toXValuexstringcenvargs-- ------------------------------------------------------------------------------- |-- string normalize-space(string?):-- returns the argument string with whitespace normalized by stripping leading-- and trailing whitespace and replacing sequences-- of whitespace characters by a single space. If the argument is omitted,-- it defaults to the context node converted to a string,-- in other words the string-value of the context node.-- The string is parsed by a function parseStr from XPathParser module. <-- No longer! Tim WalkenhorstxnormalizeSpace::XFctxnormalizeSpacec@(_,_,cn)env[]=(\(XPVStrings)->XPVString$normStrs)$xstringcenv[XPVNode$singletonNodeSetcn]xnormalizeSpacecenvargs=(\[XPVStrings]->XPVString$normStrs)$toXValuexstringcenvargs-- Tim Walkenhorst normStr replaces the use of parseStr...normStr::String->StringnormStr=unwords.words-- ------------------------------------------------------------------------------- |-- string translate(string, string, string):-- returns the first argument string with occurrences of characters in the second argument string replaced by the character at-- the corresponding position in the third argument stringxtranslate::XFctxtranslatecenvargs=xtranslate'cenv(toXValuexstringcenvargs)xtranslate'::XFctxtranslate'__((XPVStringa):(XPVStringb):[XPVStringc])=XPVString(replaceabc)xtranslate'___=XPVError"Call to xtranslate' with a wrong argument"replace::String->String->String->Stringreplacestr[]_=str-- remove all characters, if there is no corresponding character in the third argumentreplacestr(x:xs)[]=replace[s|s<-str,x/=s]xs[]replacestr(x:xs)(y:ys)=replace(repxystr)xsyswhere-- replace all characters in the first argumentrep::Char->Char->String->Stringrepab=foldr(\c->ifc==athen(b:)else(c:))""-- -------------------------------------------------------------- boolean functions-- |-- boolean boolean(object): converts its argument to a boolean valuexboolean::XFctxboolean__[XPVNumbera]=XPVBool(a/=NaN&&a/=Neg0&&a/=Pos0)xboolean__[XPVStrings]=XPVBool(lengths/=0)xboolean__[XPVBoolb]=XPVBoolbxboolean__[XPVNodens]=XPVBool(not.nullNodeSet$ns)xboolean__[XPVErrore]=XPVErrorexboolean___=XPVError"Call to xboolean with a wrong argument"-- ------------------------------------------------------------------------------- |-- boolean not(boolean): returns true if its argument is false, and false otherwisexnot::XFctxnotcenvargs=XPVBool((\(XPVBoolb)->notb)(xbooleancenvargs))-- ------------------------------------------------------------------------------- |-- boolean true(): returns truextrue::XFctxtrue___=XPVBoolTrue-- ------------------------------------------------------------------------------- |-- boolean false(): returns falsexfalse::XFctxfalse___=XPVBoolFalse-- ------------------------------------------------------------------------------- |-- boolean lang(string):-- returns true or false depending on whether the language of the context node as specified by xml:lang attributes-- is the same as or is a sublanguage of the language specified by the argument string-- --------------------------------------------------------------------------------- function needs namespaces which are not supported by the toolbox (???)xlang::XFctxlang___=XPVError"namespaces are not supported"-- xlang c env args-- = (\ (_, _, cn) [XPVString s] -> ...) c (toXValue xstring c env args)-- -------------------------------------------------------------- number functions-- |-- number number(object?): converts its argument to a numberxnumber::XFctxnumberc@(_,_,cn)env[]=(\(XPVStrings)->parseNumbers)(xstringcenv[XPVNode$singletonNodeSetcn])xnumbercenv[n@(XPVNode_)]=(\(XPVStrings)->parseNumbers)(xstringcenv[n])xnumber__[XPVBoolb]|b=XPVNumber(Float1)|otherwise=XPVNumberPos0xnumber__[XPVStrings]=parseNumbersxnumber__[XPVNumbera]=XPVNumberaxnumber__[XPVErrore]=XPVErrorexnumber___=XPVError"Call to xnumber with a wrong argument"-- ------------------------------------------------------------------------------- |-- number sum(node-set):-- returns the sum, for each node in the argument node-set, of the result of-- converting the string-values of the node to a numberxsum::XFctxsumcenv[XPVNodens]|nullNodeSetns=XPVNumberNaN|otherwise=foldr1(\ab->(xPathAddPlusab))(getValuesns)wheregetValues::NodeSet->[XPathValue]getValues=foldr(\n->([xnumbercenv$[stringValuen]]++))[].fromNodeSetxsum___=XPVError"The value of the function sum is not a nodeset"-- ------------------------------------------------------------------------------- |-- number floor(number): returns the largest (closest to positive infinity) number that is not greater-- than the argument and that is an integerxfloor::XFctxfloorcenvargs=xfloor'(toXValuexnumbercenvargs)wherexfloor'[XPVNumber(Floatf)]|f>0&&f<1=XPVNumberPos0|otherwise=XPVNumber(Float(fromInteger$floorf))xfloor'[XPVNumbera]=XPVNumberaxfloor'_=XPVError"Call to xfloor' without a number"-- ------------------------------------------------------------------------------- |-- number ceiling(number): returns the smallest (closest to negative infinity) number that is not less-- than the argument and that is an integerxceiling::XFctxceilingcenvargs=xceiling'(toXValuexnumbercenvargs)wherexceiling'[XPVNumber(Floatf)]|f<0&&f>-1=XPVNumberPos0|otherwise=XPVNumber(Float(fromInteger$ceilingf))xceiling'[XPVNumbera]=XPVNumberaxceiling'_=XPVError"Call to xceiling' without a number"-- ------------------------------------------------------------------------------- |-- number round(number):-- returns the number that is closest to the argument and that is an integer.-- If there are two such numbers, then the one that is closest to positive infinity is returned.xround::XFctxroundcenvargs=xround'cenv(toXValuexnumbercenvargs)xround'::XFctxround'__[XPVNumber(Floatf)]|f<0&&f>=-0.5=XPVNumberNeg0|f>=0&&f<0.5=XPVNumberPos0|otherwise=XPVNumber(Float(fromInteger$xPathRoundf))wherexPathRounda=ifa-(fromInteger$floora)<0.5thenflooraelsefloor(a+1)xround'__[XPVNumbera]=XPVNumberaxround'___=XPVError"Call to xround' without a number"-- ------------------------------------------------------------------------------- |-- node-set key(string, object):-- does for keys what the id function does for IDs-- The first argument specifies the name of the key.-- When the second argument is of type node-set, then the result is the-- union of the result of applying the key function to the string value-- of each of the nodes in the argument node-set.-- When the second argument is of any other type, the argument is-- converted to a stringxkey::XFctxkey_env((XPVStrings):[XPVNodens])=isInKey(getKeyTabenv)s(strValues.fromNodeSet$ns)wherestrValues=map((\(XPVStringstr)->str).stringValue)xkeycenv((XPVStrings):arg)-- = isInKey (getKeyTab env) s ( (\(XPVString s) -> words s) (xstring c env arg))=isInKey(getKeyTabenv)s[str]whereXPVStringstr=xstringcenvargxkey___=XPVError"Call to xkey with a wrong argument"isInKey::KeyTab->String->[String]->XPathValueisInKeyktknkv=XPVNode.toNodeSet$tswhere(_,_,ts)=unzip3$concat$map(isKeyVal(isKeyNamektkn))kvisKeyName::KeyTab->String->KeyTabisKeyNamektkn=filter(isOfKeyNamekn)ktisKeyVal::KeyTab->String->KeyTabisKeyValktkv=filter(isOfKeyValuekv)ktisOfKeyName::String->(QName,String,NavXmlTree)->BoolisOfKeyNamekn(qn,_,_)=localPartqn==knisOfKeyValue::String->(QName,String,NavXmlTree)->BoolisOfKeyValuekv(_,v,_)=v==kv-- ------------------------------------------------------------------------------- |-- string format-number(number, string, string?):-- converts its first argument to a string using the format pattern string-- specified by the second argument and the decimal-format named by the-- third argument, or the default decimal-format, if there is no third argumentxformatNumber::XFctxformatNumbercenv(x:xs)=xsubstring'cenv(toXValuexstringcenv[x]++toXValuexnumbercenvxs)xformatNumber___=XPVError"Call to xformatNumber with a wrong argument"-- ------------------------------------------------------------------------------- Poor man's document(...) function. Opens exactly one document.-- Does not support "fragment identifiers". "Base-URI" is always current directory.-- Should still be good enough for home use.xdocument::XFctxdocumentceval=XPVNode.toNodeSet.(\(XPVStrings)->xdocument's).xstringce$valxdocument'::String->[NavXmlTree]xdocument'uri=mapntree$unsafePerformIO$runX(readDocument[withValidateno]uri>>>addAttr"rootId"("doc "++uri))-- ------------------------------------------------------------------------------- generate-id, should be fully compliant with XSLT specification.xgenerateId::XFctxgenerateId__[XPVNodens]|not(nullNodeSetns)=xgenerateId'.headNodeSet$nsxgenerateId(_,_,node)_[]=xgenerateId'nodexgenerateId___=error"illegal arguments in xgenerateId"xgenerateId'::NavXmlTree->XPathValuexgenerateId'=XPVString.("id_"++).str2XmlId.show.nodeID.Juststr2XmlId::String->Stringstr2XmlId=concatMapconvertwhereconvertc=ifisAsciic&&(isUpperc||isLowerc||isDigitc)then[c]else"_"++(show$ordc)++"_"-- ------------------------------------------------------------xpNamePart::LAXmlTreeString->XmlTree->StringxpNamePartgetNp=concat.runLA(ifAisRoot(constA"")getNp)xpLocalPartOf::XmlTree->StringxpLocalPartOf=xpNamePartgetLocalPartxpNamespaceOf::XmlTree->StringxpNamespaceOf=xpNamePartgetNamespaceUrixpNameOf::XmlTree->StringxpNameOf=xpNamePartgetNamegetValue::String->XmlTree->StringgetValuen=concat.runLA(getAttrValuen)xpTextOf::XmlTree->StringxpTextOf=concat.runLA(xshow((getCmt>>>mkText)<+>deepisText))-- ------------------------------------------------------------