module XsltProcTemplate
where

import Data.List
import Data.Maybe
import Unicode ( Unicode, isXmlDigit, isXmlLetter )
import Util (stringToInt)
import Data.Char

import HdomParser

import XPath
import XPathFct
    ( xstring, stringValue, xnumber )

import XsltFunctions
import XsltParserFunctions
import XsltDataTypes
-- -----------------------------------------------------------------------------
-- |
-- Function library

type ProcTable = [(String, XsltFct)]

procTableTemplate :: ProcTable
procTableTemplate = [("apply-templates"         , procApplyTemplates)
                ,("value-of"                    , procValueOf)
                ,("call-template"               , procCallTemplate)
                ,("element"                     , procElement)
                ,("attribute"                   , procAttribute)
                ,("text"                        , procText)
                ,("comment"                     , procComment)
                ,("copy"                        , procCopy)
                ,("processing-instruction"      , procPi)
                ,("for-each"                    , procForEach)
                ,("if"                          , procIf)
                ,("number"                      , procNumber)
                ,("variable"                    , procVariable)
                ,("copy-of"                     , procCopyOf)
                ,("apply-imports"               , idRes)
                ,("choose"                      , procChoose)
                ,("when"                        , procWhen)
                ,("otherwise"                   , procOtherwise)
                ,("sort"                        , procSort)
                ,("param"                       , idRes) --procParam)
                                                -- procParam wird direkt aus
                                                -- setParam (processMatch) aufgerufen
                ,("with-param"                  , procWithParam)
                ,("message"                     , idRes)
                ,("fallback"                    , idRes)
                ]
-- -----------------------------------------------------------------------------
-- |
-- einlesen und verarbeiten der elemente in Templates
processTemplElems :: XsltFct
processTemplElems xsltEnv xsltStat xsltRes
    | null allChildren
        = xsltRes
    | otherwise
        = snd $ foldl (processTemplElems' xsltEnv) (xsltStat, xsltRes) allChildren
      where
        allChildren = childAxis $ currRuleNode xsltStat

processTemplElems' :: XsltEnv -> (XsltStat, XsltResult) -> NavXmlTree -> (XsltStat, XsltResult)
processTemplElems' xsltEnv (xsltStat, xsltRes) currNodeInRule
    | elem tagPrefix (xslNamespaces xsltEnv)
        = (
           stat {localVars = (localVars stat) ++ (newVars xslRes),
                localParam = (localParam stat) ++ (newParam xslRes)}
           ,xslRes
           )
    | otherwise
        = (stat, literalElements xsltEnv stat xsltRes)
      where
        stat        = xsltStat {currRuleNode = currNodeInRule}
        tagPrefix   = prefixOf $ subtreeNT currNodeInRule
        xslRes      = processXsltTag xsltEnv stat xsltRes

-- |
-- processing literal result elements
-- defined in XSLT section 7.1.1, Literal Result Elements
literalElements :: XsltFct
literalElements xsltEnv xsltStat xsltRes
    = xsltRes {resultNodes = (resultNodes xsltRes)
                                ++ [litElem xsltEnv
                                    (dataNT $ currRuleNode xsltStat)
                                    (resultNodes theChildren)
                                    ((resultAttribs attRes)
                                    ++ (resultAttribs theChildren))]
                                  }
      where
        attRes      = procXslAttributes xslAttList xsltEnv xsltStat xsltRes
        theChildren = processTemplElems xsltEnv xsltStat emptyResult
        xslAttList  = concat $ map (getXslAttList $ subtreeNT $ currRuleNode xsltStat)
                                   (xslNamespaces xsltEnv)
        
        
-- |
-- filters all attributes that belong to one of the defined namespaces
getXslAttList :: XmlTree -> String -> XmlTrees
getXslAttList tree xslNamesp = (getAttrl .> hasPrefix xslNamesp) tree

filterXslAtt :: XmlTrees -> String -> XmlTrees
filterXslAtt trees xslNamesp = (filter (\x -> (null $ hasPrefix xslNamesp x)) trees)

litElem :: XsltEnv -> XNode -> [XmlTree] -> [XmlTree] -> XmlTree
litElem _ (XText str) _ _
    = mkXTextTree str

litElem _ (XCmt str) _ _
    = mkXCmtTree str

litElem xsltEnv (XTag tn al) cs newAtts
    = mkNode (XTag (mkNSName (namePrefix tn) (localPart tn))
                (foldl filterXslAtt al (xslNamespaces xsltEnv)
                  ++
                 newAtts
                )
             ) cs

litElem _ (XAttr an) _ av
    = mkXAttrTree (localPart an) av

litElem _ (XError i str) _ _
    = mkXErrorTree i str []

litElem _ _ _ _
    = mkXErrorTree 1 "unknown XNode in litElem" []

-- |
-- "spreading" processing of xslt elements in template
processXsltTag :: XsltFct
processXsltTag xsltEnv xsltStat xsltRes
    = case (lookup (localPart qn) procTableTemplate) of
        Nothing -> xsltRes {errors
                            = (errors xsltRes)
                              ++
                              ["unknown xsl-tag found in template: '" ++ (localPart qn) ++ "'"]}
        Just fct -> fct xsltEnv xsltStat xsltRes
      where
        (XTag qn _) = dataNT $ currRuleNode xsltStat

-- -----------------------------------------------------------------------------
-- |
-- search rules (match) for the current node in source tree
-- and processing the rule
processMatch :: XsltFct
processMatch xsltEnv xsltStat xsltRes
    = processTemplElems xsltEnv stat xsltRes
      where
        stat    = xsltStat
                    {
                    ruleBody = newRule
                    ,currRuleNode = newRule
                    ,localParam = theParameter
                    }
        newRule = findMatchRule xsltEnv xsltStat xsltRes
        -- uebergabe von xsltRes an findMatchRule momentan wirkungslos, da
        -- auftretende fehler noch nicht weitergegeben werden!
        theParameter = setParam (subtreeNT newRule) xsltEnv xsltStat

-- |
-- search rules (name) for the current node in source tree
-- and processing the rule
-- (only called from xsl:call-template)
processName :: XsltEnv -> XsltStat -> QName -> XsltResult
processName xsltEnv xsltStat qn
    = processTemplElems xsltEnv stat emptyResult
      where
        stat    = xsltStat
                    {
                    ruleBody = newRule
                    ,currRuleNode = newRule
                    ,localParam = theParameter
                    }
        newRule = findNameRule (nameRules xsltEnv) qn
        theParameter = setParam (subtreeNT newRule) xsltEnv xsltStat

-- |
-- reads all param in xsl:param and adds it to the current param list
setParam :: XmlTree -> XsltEnv -> XsltStat -> XsltVarTab
setParam currRule xsltEnv xsltStat
    = foldl renewParam (newParam allParamRes) (withParam xsltStat)
      where
        allParamRes     = foldl (procParam xsltEnv xsltStat) emptyResult allParamElems
        allParamElems   = multi (isTag "xsl:param") currRule
        
-- |
-- check if the given param is in current param-list
-- if its in, old value will be deleted, new is written in list
renewParam :: XsltVarTab -> XsltVar -> XsltVarTab
renewParam allParam oneNewParam@(paramName, _)
    = case (lookup paramName allParam) of
        Nothing -> allParam
        Just value -> oneNewParam : (delete (paramName,value) allParam)

-- -----------------------------------------------------------------------------
-- processing elements in template

idRes :: XsltFct
idRes _ _ xsltRes = xsltRes

-- |
-- processing xsl:apply-templates
-- defined in XSLT section 5.4, Applying Template Rules
procApplyTemplates :: XsltFct
procApplyTemplates xsltEnv xsltStat xsltRes
    = foldl (procApplyTemplates' xsltEnv stat) xsltRes (currNodeList stat)
      where
        stat = xsltStat {
                currNodeList    = newList
                ,conLen         = length newList
                ,mode           = mkNSName
                                  (prefixOf $ subtreeNT $ currRuleNode xsltStat)
                                  --""
                                 (getXslAttribute "mode" xsltStat)
                ,withParam      = newParam $ snd withParamResult
               }
        xsltData    = getXsltData xsltStat xsltEnv XsltVar
        nt          = currRuleNode xsltStat
        select      = getXslAttribute "select" xsltStat
        newList     = sortNodeList xsltStat xsltEnv (sortKeys $ snd sortKeysRes)
                      $ newNodeList select xsltStat xsltEnv
        withParamResult = foldl (processTemplElems' xsltEnv) (xsltStat, xsltRes)
                             $ getExprNodes xsltData nt "with-param" (xslNamespaces xsltEnv)

        sortKeysRes = foldl (processTemplElems' xsltEnv) (xsltStat, xsltRes)
                             $ getExprNodes xsltData nt "sort" (xslNamespaces xsltEnv)
        

procApplyTemplates' :: XsltEnv -> XsltStat -> XsltResult -> NavXmlTree -> XsltResult
procApplyTemplates' xsltEnv xsltStat xsltRes currentNode
    = processMatch xsltEnv (xsltStat {currNode = currentNode}) xsltRes

-- |
-- processing xsl:value-of
-- defined in XSLT section 7.6.1, Generating Text with xsl:value-of
--
-- to do:   "disable-output-escaping" attribute
procValueOf :: XsltFct
procValueOf xsltEnv xsltStat xsltRes
    | selectValue == ""
        = xsltRes {errors = (errors xsltRes) ++ ["missing select attribute in value-of node"]}
    | null selectedNodes
        = xsltRes {errors = (errors xsltRes) ++ ["no result from selet-value-eval"]}
    | (null attrDoe) || (attrDoe == "no")
        = xsltRes {resultNodes = (resultNodes xsltRes) ++ (escapeXmlText $$ xPValue2XmlTrees $ xstring (0 ,0, ntree emptyRoot) xsltDat selectedNodes)}
    | otherwise
        = xsltRes {resultNodes = (resultNodes xsltRes) ++ (xPValue2XmlTrees $ xstring (0 ,0, ntree emptyRoot) xsltDat selectedNodes)}
      where
        selectValue = getXslAttribute "select" xsltStat
        attrDoe     = getXslAttribute "disable-output-escaping" xsltStat
        selectedNodes = [evalXPExpr xsltData selectValue ((conPos xsltStat),(conLen xsltStat), (currNode xsltStat)) ]
        xsltData    = getXsltData xsltStat xsltEnv XsltAll
        xsltDat     = convertXsltDataToXPathEnv xsltData
        

-- |
-- processing xsl:call-template
-- defined in XSLT section 6, Named Templates
procCallTemplate :: XsltFct
procCallTemplate xsltEnv xsltStat xsltRes
    = xsltRes {resultNodes
                 = (resultNodes xsltRes) ++ (resultNodes theChildren)
               , errors
                 = (errors xsltRes) ++ (errors $ snd withParamResult) ++ (errors theChildren)}
      where
        theChildren     = processName xsltEnv stat $ getQName $ getXslAttribute "name" xsltStat
        stat            = xsltStat {withParam = newParam $ snd withParamResult}
        withParamResult = foldl (processTemplElems' xsltEnv) (xsltStat, xsltRes)
                             $ getExprNodes (getXsltData xsltStat xsltEnv XsltVar)
                              (currRuleNode xsltStat) "with-param" (xslNamespaces xsltEnv)

-- |
-- processing xsl:element-knoten
-- defined in XSLT section 7.1.2, Creating Elements with xsl:element 
--
-- to do:   "namespace" attribute
procElement :: XsltFct
procElement xsltEnv xsltStat xsltRes
    | elemName == "" = xsltRes
    | otherwise      = xsltRes {resultNodes
                         = (resultNodes xsltRes)
                           ++ (xtag elemName
                              ((resultAttribs attRes) ++ (resultAttribs theChildren))
                              (resultNodes theChildren))}
      where
        attRes      = procXslAttributes xslAttList xsltEnv xsltStat xsltRes
        xslAttList  = (getAttrl .> hasLocalPart "use-attribute-sets") $ subtreeNT $ currRuleNode xsltStat
        elemName    = mkElemName (getXsltData xsltStat xsltEnv XsltVar) xsltStat $ getXslAttribute "name" xsltStat
        theChildren = processTemplElems xsltEnv xsltStat emptyResult
        

-- |
-- processing xsl:attribute
-- defined in XSLT section 7.1.3, Creating Attributes with xsl:attribute 
--
-- to do:   "namespace" attribute
procAttribute :: XsltFct
procAttribute xsltEnv xsltStat xsltRes
    | null (resultNodes childs)
        = xsltRes {errors
                   = (errors xsltRes) ++ ["empty xsl:attribute-tag"]
                  }
    | otherwise
        = xsltRes {resultAttribs
                   = (resultAttribs xsltRes)
                     ++ [mkXAttrTree attrName $ collapseXText $$ (resultNodes childs)]
                  }
      where
        attrName        = mkElemName (getXsltData xsltStat xsltEnv XsltVar)
                                     xsltStat
                                     $ getXslAttribute "name" xsltStat
        --attNamespace    = getXslAttribute "namespace" xsltStat
        childs          = processTemplElems xsltEnv xsltStat emptyResult


-- |
-- processing xsl:text
-- defined in XSLT section 7.2, Creating Text
--
-- to do:   "disable-output-escaping" attribute
procText :: XsltFct
procText _ xsltStat xsltRes
    | (null attrDoe) || (attrDoe == "no")
      = xsltRes {resultNodes
                 = (resultNodes xsltRes)
                   ++ (collapseXText $$ escapeXmlText $ mkXTextTree
                       $ xPValue2String $ stringValue $ currRuleNode xsltStat)}
    | otherwise
      = xsltRes {resultNodes
                 = (resultNodes xsltRes)
                   ++ (collapseXText $ mkXTextTree $ xPValue2String
                       $ stringValue $ currRuleNode xsltStat)}
      where
        attrDoe = getXslAttribute "disable-output-escaping" xsltStat
    

-- |
-- processing xsl:comment-knoten
-- defined in XSLT section 7.4, Creating Comments 
procComment :: XsltFct
procComment _ xsltStat xsltRes
    = xsltRes {resultNodes
               = (resultNodes xsltRes)
                  ++ [mkXCmtTree $ xPValue2String $ stringValue $ currRuleNode xsltStat]
               }


-- |
-- processing xsl:copy
-- defined in XSLT section 7.5, Copying
procCopy :: XsltFct
procCopy xsltEnv xsltStat xsltRes
    | elemName == ""
        = xsltRes
    | isXTagNode currElem
        = xsltRes {newVars      = (newVars theChildren)
                   ,resultNodes = (resultNodes xsltRes)
                                  ++ (xtag elemName 
                                     ((resultAttribs attRes) ++ (resultAttribs theChildren))
                                     (resultNodes theChildren))}
    | otherwise
        = xsltRes {resultNodes  = (resultNodes xsltRes)
                                  ++ [mkLeaf currElem]}
      where
        attRes      = procXslAttributes xslAttList xsltEnv xsltStat xsltRes
        xslAttList  = (getAttrl .> hasLocalPart "use-attribute-sets") $ subtreeNT $ currRuleNode xsltStat
        theChildren = processTemplElems xsltEnv xsltStat emptyResult
        elemName    = nameOf $ subtreeNT $ currNode xsltStat
        currElem    = dataNT $ currNode xsltStat
        -- elemName liefert derzeit nur den localpart zurueck (String)
        -- sollte dann mal den QName zurueckliefern 
        -- der wurzelknoten muss noch besonders behandelt werden (s. Spezi 7.5)


-- |
-- processing xsl:processing-instruction
-- defined in XSLT section 7.3, Creating Processing Instructions
procPi :: XsltFct
procPi xsltEnv xsltStat xsltRes
    = xsltRes {resultNodes =  (resultNodes xsltRes) ++ [mkXPiTree elemName piValue]}
      where
        xsltData    = ((localVars xsltStat) ++ (globalVars xsltEnv),[])
        elemName    = mkElemName xsltData xsltStat $ getXslAttribute "name" xsltStat
        piValue     = xPValue2String $ stringValue $ currRuleNode xsltStat
        
 
-- |
-- processing xsl:for-each
-- defined in XSLT section 8, Repetition
procForEach :: XsltFct
procForEach xsltEnv xsltStat xsltRes
    = xsltRes {resultNodes = (resultNodes res)}
      where
        res     = foldl (procForEach' xsltEnv stat) xsltRes (currNodeList stat)
        stat    = xsltStat {currNodeList    = newList
                            ,conLen         = length newList
                            }
        select  = getXslAttribute "select" xsltStat
        newList = sortNodeList xsltStat xsltEnv (sortKeys $ snd sortKeysRes)
                   $ newNodeListFE select xsltStat xsltEnv
        
        sortKeysRes = foldl (processTemplElems' xsltEnv) (xsltStat, xsltRes)
                             $ getExprNodes (getXsltData xsltStat xsltEnv XsltVar)
                               (currRuleNode xsltStat) "sort" (xslNamespaces xsltEnv)

-- helper function for procForEach (xsl:for-each)
-- called for every selected node 
procForEach' :: XsltEnv -> XsltStat -> XsltResult -> NavXmlTree -> XsltResult
procForEach' xsltEnv xsltStat xsltRes newCurrNode
    = processTemplElems xsltEnv stat xsltRes
      where
        stat        = xsltStat {currNode = newCurrNode ,conPos = newConPos}
        newConPos   = 1 + (fromJust $ elemIndex newCurrNode (currNodeList xsltStat))


-- |
-- processing xsl:if
-- defined in XSLT section 9.1, Conditional Processing with xsl:if
procIf :: XsltFct
procIf xsltEnv xsltStat xsltRes
    | xPValue2Bool testValue
        = xsltRes {newVars      = (newVars theChildren)
                   ,resultNodes =  (resultNodes xsltRes) ++ (resultNodes theChildren)
                   ,resultAttribs =  (resultAttribs xsltRes) ++ (resultAttribs theChildren) }
    | otherwise
        = xsltRes
      where
        testValue   = evalXPExpr (getXsltData xsltStat xsltEnv XsltVar)
                                  (getXslAttribute "test" xsltStat)
                                  ((conPos xsltStat),(conLen xsltStat), (currNode xsltStat))
        theChildren = processTemplElems xsltEnv xsltStat emptyResult


-- |
-- processing xsl:choose
-- defined in XSLT section 9.2, Conditional Processing with xsl:choose
procChoose :: XsltFct
procChoose xsltEnv xsltStat xsltRes
    | not $ null $ resultNodes whenTestRes
        = xsltRes {resultNodes = (resultNodes xsltRes) ++ (resultNodes whenTestRes)}
    | null $ resultNodes otherRes
        = xsltRes {errors = (errors xsltRes) ++ (errors otherRes) ++ (errors whenTestRes)}
    | otherwise 
        = xsltRes {resultNodes = (resultNodes xsltRes) ++ (resultNodes otherRes)}
      where
        xsltData    = getXsltData xsltStat xsltEnv XsltVar
        otherRes    = others
                        (getExprNodes xsltData (currRuleNode xsltStat) "otherwise" (xslNamespaces xsltEnv))
                        xsltEnv xsltStat xsltRes
        whenTestRes = testWhen
                        (getExprNodes xsltData (currRuleNode xsltStat) "when" (xslNamespaces xsltEnv))
                        xsltEnv xsltStat xsltRes
                        

-- |
-- processing xsl:when
-- defined in XSLT section 9.2, Conditional Processing with xsl:choose
procWhen :: XsltFct
procWhen xsltEnv xsltStat xsltRes
    | xPValue2Bool testValue
        = xsltRes {newVars
                    = (newVars theChildren)
                  ,resultNodes
                    =  (resultNodes xsltRes) ++ [mkRootTree [] (resultNodes theChildren)]
                  ,resultAttribs
                    =  (resultAttribs xsltRes) ++ [mkRootTree [] (resultAttribs theChildren)]}
    | otherwise = xsltRes
      where
        testValue   = evalXPExpr
                      (getXsltData xsltStat xsltEnv XsltVar)
                      (getXslAttribute "test" xsltStat)
                      ((conPos xsltStat),(conLen xsltStat), (currNode xsltStat))
        theChildren = processTemplElems xsltEnv xsltStat emptyResult

-- |
-- processing xsl:otherwise
-- defined in XSLT section 9.2, Conditional Processing with xsl:choose
procOtherwise :: XsltFct
procOtherwise xsltEnv xsltStat xsltRes
    = xsltRes {newVars
                 = (newVars theChildren)
               ,resultNodes
                 = (resultNodes xsltRes) ++ [mkRootTree [] (resultNodes theChildren)]
               ,resultAttribs
                 = (resultAttribs xsltRes) ++ [mkRootTree [] (resultAttribs theChildren)]}
      where
        theChildren = processTemplElems xsltEnv xsltStat emptyResult


-- |
-- processing xsl:number
-- defined in XSLT section 7.7, Numbering
--
-- to do:   "lang" and "letter-value" attribute
procNumber :: XsltFct
procNumber xsltEnv xsltStat xsltRes
    | null valueAtt
        = xsltRes {resultNodes
                    = (resultNodes xsltRes)
                      ++ [mkXTextTree
                          (formatNumber formatAtt
                          (procNumber' levelAtt countAtt fromAtt xsltStat)
                          grpSizeAtt grpSepAtt
                       )] }
    | otherwise
        = xsltRes {resultNodes
                    = (resultNodes xsltRes)
                      ++ [mkXTextTree
                          (formatNumber formatAtt
                          [xPValue2Int $ evalNumber xsltData valueAtt xsltStat]
                          grpSizeAtt grpSepAtt
                      )] }
      where
        xsltData    = (getXsltVars xsltStat xsltEnv XsltAll,[])
        valueAtt    = getXslAttribute "value" xsltStat
        formatAtt   = getXslAttribute "format" xsltStat
        --langAtt     = getXslAttribute "lang" xsltStat
        --letValAtt   = getXslAttribute "letter-value" xsltStat
        grpSepAtt   = getXslAttribute "grouping-seperator" xsltStat
        grpSizeAtt  = stringToInt 10 $ getXslAttribute "grouping-size" xsltStat
        levelAtt    = getXslAttribute "level" xsltStat
        countAtt    = getCountAtt xsltStat $ getXslAttribute "count" xsltStat
        fromAtt     = getXslAttribute "from" xsltStat


-- helper function for procNumber
getCountAtt :: XsltStat -> String -> String
getCountAtt xsltStat countAtt
    | countAtt == ""    = nameOf $ subtreeNT $ currRuleNode xsltStat
    | otherwise         = countAtt


-- helper function for procNumber
procNumber' :: String -> String -> String -> XsltStat -> [Int]
procNumber' levelAtt countAtt fromAtt xsltStat
    | levelAtt == "multiple"
        = reverse $ map (\x -> 1 + (length x)) 
                  $ map (filterPatternNT stepListsCount) (map precedingSiblingAxis facS)
    | levelAtt == "any"
        = [(length $ filterPatternNT stepListsCount
                   $ fromAndCount
                     ((ancestorOrSelfAxis $ currNode xsltStat) ++ (precedingAxis $ currNode xsltStat))
                     (fromAttPreceding stepListsFrom "prec" xsltStat)
          )]
    | null facS
        = []
    | otherwise
        = [1 + (length $ filterPatternNT stepListsCount (precedingSiblingAxis $ head facS))]
      where
        stepListsCount = patternParser countAtt
        stepListsFrom = patternParser fromAtt
        facS = fromAndCount
                (countAttAncestors stepListsCount xsltStat)
                (fromAttPreceding stepListsFrom "anc" xsltStat)



-- |
-- processing xsl:variable
-- defined in XSLT section 11.2, Values of Variables and Parameters
--                     and 11.5, Variables and Parameters within Templates
procVariable :: XsltFct 
procVariable xsltEnv xsltStat xsltRes
    | valName == ""
        = xsltRes {errors = (errors xsltRes) ++ ["no 'name' attribute given for variable-node!"]}
    | select /= ""
        = xsltRes {newVars = addVars replace globVars valName $ head selectValue}
    | not $ null $ resultNodes theChildren
        = xsltRes {newVars = addVars replace vars valName (XPVNode [ntree (mkRootTree [] (resultNodes theChildren))]) }
          --xsltRes {newVars = addVars replace vars valName (XPVNode (map ntree children))}
    | null selectValue
        = xsltRes {errors = (errors xsltRes) ++ ["no result from selet-value-eval"]}
    | otherwise
        = xsltRes {newVars = addVars replace vars valName (XPVString "")}
      where
        vars        = (localVars xsltStat) ++ (globalVars xsltEnv)
        globVars    = globalVars xsltEnv
        select      = getXslAttribute "select" xsltStat
        valName     = getXslAttribute "name" xsltStat
        theChildren = processTemplElems xsltEnv xsltStat emptyResult
        selectValue = [evalXPExpr (getXsltData xsltStat xsltEnv XsltVar) select (1,1, currRuleNode xsltStat) ]


-- |
-- processing xsl:param
-- defined in XSLT section 11.2, Values of Variables and Parameters
--                     and 11.5, Variables and Parameters within Templates
procParam :: XsltEnv -> XsltStat -> XsltResult -> XmlTree -> XsltResult
procParam xsltEnv xsltStat xsltRes paramElement
    | paramName == ""
        = xsltRes {errors = (errors xsltRes) ++ ["no 'name' attribute given for param-node!"]}
    | not $ null paramErrors
        = xsltRes {errors = (errors xsltRes) ++ paramErrors}
    | null newParamList
        = xsltRes {newParam = addVars replace (newParam xsltRes) paramName (XPVString "")}
    | otherwise
        = xsltRes {newParam = (newParam xsltRes) ++ newParamList}
      where
        paramName = valueOf "name" paramElement
        (newParamList, paramErrors)
            = getParam xsltEnv xsltStat xsltRes (valueOf "select" paramElement) paramName 
    

-- |
-- processing xsl:with-param
-- defined in XSLT section 11.6, Passing Parameters to Templates
procWithParam :: XsltFct
procWithParam xsltEnv xsltStat xsltRes
    | valName == ""
        = xsltRes {errors = (errors xsltRes) ++ ["no 'name' attribute given for param-node!"]}
    | select /= ""
        = xsltRes {newParam = addVars notReplace (newParam xsltRes) valName $ head selectValue}
    | not $ null $ resultNodes theChildren
        = xsltRes {newParam = addVars notReplace vars valName (XPVNode [ntree (mkRootTree [] (resultNodes theChildren))]) }
    | null selectValue
        = xsltRes {errors = (errors xsltRes) ++ ["no result from selet-value-eval"]}
    | otherwise
        = xsltRes {newParam = addVars notReplace (newParam xsltRes) valName (XPVString "")}
      where
        vars        = getXsltVars xsltStat xsltEnv XsltAll
        select      = getXslAttribute "select" xsltStat
        valName     = getXslAttribute "name" xsltStat
        theChildren = processTemplElems xsltEnv xsltStat emptyResult
        selectValue = [evalXPExpr (getXsltData xsltStat xsltEnv XsltAll)
                      select
                      (1,1, currRuleNode xsltStat) ]


-- |
-- processing xsl:copy-of
-- defined in XSLT section 11.3 Using Values of Variables and Parameters with xsl:copy-of
-- result tree fragments are treated like nodesets
-- no limitation of functions fo now
procCopyOf :: XsltFct
procCopyOf xsltEnv xsltStat xsltRes
    | select == ""
        = xsltRes
    | null nodeList
        = xsltRes {resultNodes = (resultNodes xsltRes)
                    ++ (xPValue2XmlTrees $ xstring (0 ,0, ntree emptyRoot) xsltDat [selectValue])
                  }
    | otherwise
        = xsltRes {resultNodes = (resultNodes xsltRes)
                    ++ (toXPathTree $ childAxis $ sourceNavTree xsltEnv)
                  }
      where
        xsltData    = ((localVars xsltStat) ++ (globalVars xsltEnv),[])
        xsltDat     = convertXsltDataToXPathEnv xsltData
        select      = getXslAttribute "select" xsltStat
        selectValue = evalXPExpr xsltData select (1,1, currRuleNode xsltStat)
        nodeList    = xPValue2NavXmlTrees selectValue

-- |
-- processing xsl:sort
-- defined in XSLT section 10 Sorting
procSort :: XsltFct
procSort _ xsltStat xsltRes
    = xsltRes {sortKeys =
                (sortKeys xsltRes)
                ++ [
                   SK {sortKey      = getXslAttribute "select"     xsltStat
                       ,lang        = getXslAttribute "lang"       xsltStat
                       ,dataType    = getXslAttribute "data-type"  xsltStat
                       ,order       = getXslAttribute "order"      xsltStat
                       ,caseOrder   = getXslAttribute "case-order" xsltStat
                   }]
               }




-- -------------------------------
-- helper functions for procNumber

fromAndCount :: [NavXmlTree] -> [NavXmlTree] -> [NavXmlTree]
fromAndCount countList fromList
    | null countList    = []
    | null fromList     = countList
    | otherwise         = intersect countList fromList

-- all ancestors matching countAtt
countAttAncestors :: [XsltStepList] -> XsltStat -> [NavXmlTree]
countAttAncestors stepListsCount xsltStat
    | null stepListsCount   = []
    | otherwise             = filterPatternNT stepListsCount (ancestorOrSelfAxis $ currNode xsltStat)

-- all nodes matching fromAtt
fromAttPreceding :: [XsltStepList] -> String -> XsltStat -> [NavXmlTree]
fromAttPreceding stepListsFrom axis xsltStat
    | null stepListsFrom    = []
    | axis == "anc"         = procFromAtt stepListsFrom
                              (ancestorOrSelfAxis $ currNode xsltStat)
    | otherwise             = procFromAtt stepListsFrom
                              ((ancestorOrSelfAxis $ currNode xsltStat)
                                ++ (precedingAxis $ currNode xsltStat))

procFromAtt :: [XsltStepList] -> [NavXmlTree] -> [NavXmlTree]
procFromAtt stepListsFrom ntl
    | null fromSingle   = []
    | otherwise         = descendantAxis $ head fromSingle
      where
        fromSingle = filterPatternNT stepListsFrom ntl


evalNumber :: XsltData -> String -> XsltStat -> XPathValue
evalNumber xsltData valueAtt xsltStat
    | valueAtt == ""
        = xnumber   (0 ,0, ntree emptyRoot)
                    xsltDat
                    [evalExpr   xsltDat
                                ((conPos xsltStat), (conLen xsltStat), currRuleNode xsltStat)
                                (FctExpr "position" [])
                                (XPVNode [currRuleNode xsltStat])]
    | otherwise
        = xnumber   (0 ,0, ntree emptyRoot)
                    xsltDat
                    [evalXPExpr xsltData
                                valueAtt
                                ((conPos xsltStat),(conLen xsltStat), (currNode xsltStat))]
      where
        xsltDat   = convertXsltDataToXPathEnv xsltData


-- formatting number -----------------------------------------------------
-- parameter:   list of ints: values to be formatted
--              string: the format
-- result   :   formatted string
formatNumber :: String -> [Int] -> Int -> String -> String
formatNumber _ [] _ _
    = ""
formatNumber str iList grpSize grpSeperator
    = transformIntList (intToTokenList (if null str then "1." else str)) iList grpSize grpSeperator

transformIntList :: [FormToken] -> [Int] -> Int -> String -> String
transformIntList form iList grpSize grpSeperator
    = fS
      ++
      (concat $ zipWith (replaceNum grpSize grpSeperator) iList formatFktListe )
      ++
      lS
    where
    (SToken fS, SToken lS, fL) = generateFunctions form
    anz                        = (length iList) - (length fL)
    formatFktListe             = fL ++ (take anz $ repeat $ head $ take 1 $ reverse fL)

defFct :: FormToken -> [XsltNumFormat] -> [XsltNumFormat]
defFct (SToken _) []
    = [(NF {seperator = ""  , formLen  = 1, formFct  = formatDez})
      ,(NF {seperator = "." , formLen  = 1, formFct  = formatDez})]
defFct (SToken st) (fF : _)
    = [fF
      ,(NF {seperator = st  , formLen  = formLen fF, formFct  = formFct fF})]
defFct _ _ = []

replaceNum :: Int -> String -> Int -> XsltNumFormat -> String
replaceNum grpSize grpSeperator toReplace numFormat
    = (formFct numFormat) (seperator numFormat) toReplace (formLen numFormat) grpSize grpSeperator


generateFunctions :: [FormToken] -> (FormToken, FormToken, [XsltNumFormat])
generateFunctions tokenList
    | null restListe    = (fS, lS, defFct lS fF)
    | otherwise         = (fS, lS, fF ++ (genFctList restListe))
      where
        (fS, lS, rest) = firstLastSep tokenList
        (fF,restListe) = genFirstFct rest


genFctList :: [FormToken] -> [XsltNumFormat]
genFctList [] = []
genFctList ((SToken st) : r)
    = [NF {seperator = st
          ,formLen   = length f
          ,formFct   = chooseFktForm ft
          }]
      ++ (genFctList rl)
      where
        (ft@(FToken f),rl) = getForm r
genFctList ((FToken _) : _)= []

genFirstFct :: [FormToken] -> ([XsltNumFormat], [FormToken])
genFirstFct [] = ([],[])
genFirstFct (ft@(FToken f) : r)
    = ([NF {seperator = ""
            ,formLen  = length f
            ,formFct  = chooseFktForm ft
          }],r)
genFirstFct tl@((SToken _) : _) = ([],tl)



firstLastSep :: [FormToken] -> (FormToken,FormToken,[FormToken])
firstLastSep []         = (SToken [],SToken [],[])
firstLastSep tokenList  = (fs,ls,reverse rest2)
    where
        (fs,rest1) = getSep tokenList
        (ls,rest2) = getSep $ reverse rest1
        
-- |
-- returns first token of list if its a seperator
getSep :: [FormToken] -> (FormToken,[FormToken])
getSep (st@(SToken _):r)    = (st, r)
getSep l                    = (SToken [], l)

-- |
-- returns first token of list if its a format token
getForm :: [FormToken] -> (FormToken,[FormToken])
getForm (ft@(FToken _):r)   = (ft, r)
getForm l                   = (SToken [], l)


-- |
-- converts a list of ints to a list of tokens
intToTokenList :: String -> [FormToken]
intToTokenList [] = []
intToTokenList [i]
    | isAlphaNmb i  = [FToken [i]]
    | otherwise     = [SToken [i]]
intToTokenList l@(i:_)
    | isAlphaNmb i  = (FToken frm) : (intToTokenList $ drop (length frm) l)
    | otherwise     = (SToken sep) : (intToTokenList $ drop (length sep) l)
      where
        frm = (takeWhile isAlphaNmb l)
        sep = (takeWhile isNotAlphaNmb l)

-- |
-- test if format token
isAlphaNmb :: Unicode -> Bool
isAlphaNmb c = isXmlLetter c || isXmlDigit c

-- |
-- test if seperator token
isNotAlphaNmb :: Unicode -> Bool
isNotAlphaNmb c = not $ isAlphaNmb c



-- |
-- select right formatting function for format token
chooseFktForm :: FormToken -> XsltFormatFct
chooseFktForm (FToken [])   = formatDez
chooseFktForm (FToken f)
    | isDigi            = formatDez
    | (head f) == 'A'   = formatA
    | (head f) == 'a'   = formata
    | (head f) == 'I'   = formatRoman
    | (head f) == 'i'   = formatRoman2
    | otherwise         = formatDez
      where
        isDigi = ((head $ reverse f) == '1')
                 && (and $ map (== '0') (tail $ reverse f))
chooseFktForm (SToken _)= formatDez

-- formatting functions
-- |
-- formatting function for decimals
-- generate sequences like 1 2 3 ... 10 11 12 ....
--                    or   01 02 03 ... 09 10 11 ... 99 100 101 ....
formatDez :: XsltFormatFct
formatDez sep toReplace len grpSize grpSeperator
    | len == 1  = sep ++ (sGS $ show toReplace)
    | otherwise = sep ++ (sGS $ reverse $ take len $ reverse ((replicate len '0') ++ (show toReplace)))
      where
        sGS str = setGrpSep grpSize grpSeperator $ reverse str

-- |
-- insert grouping seperator in decimal
setGrpSep :: Int -> String -> String -> String
setGrpSep grpSize grpSeperator resString
    | length resString <= grpSize || null grpSeperator || grpSize == 0
        = reverse resString
    | otherwise
        = (setGrpSep grpSize grpSeperator $ drop grpSize resString)
            ++ (reverse ((take grpSize resString) ++ grpSeperator))


-- |
-- generate sequences like A B C ... Z AA AB AC ....
formatA ::  XsltFormatFct
formatA sep toReplace _ _ _
    | r == 0    = sep ++ [chr (64 + m)]
    | otherwise = sep ++ (formatA "" r 0 0 "") ++ [chr (65 + m)]
      where
        (r, m) = divMod toReplace 27

-- |
-- generate sequences like a b c  ... z aa ab ac ....
formata ::  XsltFormatFct
formata sep toReplace _ _ _
    | r == 0    = sep ++ [chr (96 + m)]
    | otherwise = sep ++ (formata "" r 0 0 "") ++ [chr (97 + m)]
      where
        (r,m) = divMod toReplace 27

-- |
-- generate sequences like I II III IV V VI VII VIII IX X ....
formatRoman :: XsltFormatFct
formatRoman sep toReplace _ _ _
    | toReplace > 3999  = "#error: Roman number has to be less than 4000!"
    | otherwise         = sep ++ (getRomanLetter toReplace romanList)

-- |
-- generate sequences like i ii iii iv v vi vii viii ix x ....
formatRoman2 :: XsltFormatFct
formatRoman2 sep toReplace _ _ _
    = map toLower $ formatRoman sep toReplace 1 0 ""

-- |
-- generate roman
getRomanLetter	:: Int -> [(Int,String)] -> String
getRomanLetter _ [] = "#error: Error while transforming to roman numbers!"
getRomanLetter i ((intVal, romanLetter) : l)
    | i == 0        = ""
    | i < intVal    = getRomanLetter i l
    | otherwise     = romanLetter ++ (getRomanLetter (i - intVal) romanList)

romanList :: [(Int,String)]
romanList = [(1000, "M")    ,(900,  "CM")
            ,(500,  "D")    ,(400,  "CD")
            ,(100,  "C")    ,(90,   "XC")
            ,(50,   "L")    ,(40,   "XL")
            ,(10,   "X")    ,(9,    "IX")
            ,(5,    "V")    ,(4,    "IV")
            ,(1,    "I")    ,(1,    "I")]
-- --------------------------



-- --------------------------
-- helper functions for procChoose
-- |
getNodes :: Expr -> XsltEnv -> XsltStat -> NavXmlTrees
getNodes pathExpr xsltEnv xsltStat
    = xPValue2NavXmlTrees
        $ evalExpr
            (convertXsltDataToXPathEnv (((localVars xsltStat) ++ (globalVars xsltEnv)),[]))
            (1, 1, currRuleNode xsltStat)
            pathExpr
            (XPVNode [currRuleNode xsltStat])

others :: NavXmlTrees -> XsltFct
others [] _ _ _                         = emptyResult
others (ot:_) xsltEnv xsltStat xsltRes  = processTemplElems xsltEnv (xsltStat {currRuleNode = ot}) xsltRes

testWhen :: NavXmlTrees -> XsltFct
testWhen [] _ _ _
    = emptyResult
testWhen (w:wListe) xsltEnv xsltStat xsltRes
    | xPValue2Bool testValue
        = processTemplElems xsltEnv (xsltStat {currRuleNode = w}) xsltRes
    | otherwise
        = testWhen wListe xsltEnv xsltStat xsltRes
      where
        testValue   = evalXPExpr (getXsltData xsltStat xsltEnv XsltVar)
                                 (valueOf "test" $ subtreeNT $ w)
                                 ((conPos xsltStat),(conLen xsltStat), (currNode xsltStat))


-- --------------------------------
-- helper functions for procForEach
-- |
-- sets current nodelist
-- selects nodes that match the select attribute
-- is no select attribute given no node ist selected
newNodeListFE :: String -> XsltStat -> XsltEnv -> NavXmlTrees
newNodeListFE selectValue xsltStat xsltEnv
    | selectValue == ""             -- select attribut is emty or missing
        = []
    | null selectedNodes            -- no matching element found
        = []
    | otherwise                     -- select attribut returns selected nodes
        = xPValue2NavXmlTrees $ head selectedNodes
      where
        selectedNodes = [evalXPValExpr (getXsltData xsltStat xsltEnv XsltVar)
                                       selectValue
                                       (1,1, (currNode xsltStat)) ]


-- ----------------------------------
-- helper functions for procApplyTemplates
-- |
-- sets current nodelist
-- selects nodes that match the select attribute
-- is no select attribute given no node ist selected
newNodeList :: String -> XsltStat -> XsltEnv -> NavXmlTrees
newNodeList selectValue xsltStat xsltEnv
    | selectValue == ""             -- select attribut is emty or missing
        = childAxis $ currNode xsltStat
    | null selectedNodes            -- no matching element found
        = []
    | otherwise                     -- select attribut returns selected nodes
        = xPValue2NavXmlTrees $ head selectedNodes
      where
        selectedNodes = [evalXPExpr (getXsltData xsltStat xsltEnv XsltVar)
                                    selectValue
                                    (1,1, (currNode xsltStat)) ]


-- --------------------------------------
-- helper functions for procParam
-- |
getParam :: XsltEnv -> XsltStat -> XsltResult -> String -> String -> ([XsltVar], [String])
getParam xsltEnv xsltStat xsltRes select paramName
    | select /= ""
        = (addVars replace (newParam xsltRes) paramName $ head selectValue,[])
    | not $ null $ resultNodes theChildren
        = (addVars replace (newParam xsltRes) paramName (XPVNode [ntree (mkRootTree [] (resultNodes theChildren))]),[])
    | null selectValue
        = ([],(errors xsltRes) ++ ["no result from select-value-eval"])
    | otherwise
        = ([],[])
      where
        theChildren     = processTemplElems xsltEnv xsltStat emptyResult
        selectValue     = [evalXPExpr (getXsltData xsltStat xsltEnv XsltAll)
                                      select
                                      (1,1, currRuleNode xsltStat) ]


-- -----------------------------------------------------------------------------
-- |
-- processing XSL attributes in literal result elements
-- possible attribute:
-- use-attribute-sets
procXslAttributes :: XmlTrees -> XsltFct
procXslAttributes [] _ _ xsltRes
    = xsltRes {resultNodes = []}
procXslAttributes [(NTree (XAttr an) av)] xsltEnv _ xsltRes
    | (localPart an) == "use-attribute-sets"
        = xsltRes { resultAttribs
                     = (resultAttribs xsltRes)
                       ++
                       (filterAttribueSets (attSets xsltEnv)
                            $ zipWith mkNSName (fst qn) (snd qn))
                  }
    | otherwise = xsltRes {resultNodes = []}
      where
        qn = unzip $ qnamesParser (showXText av)

procXslAttributes _ _ _ xsltRes
    = xsltRes {errors
               = (errors xsltRes) ++ ["ERROR: Call to 'procXslAttributes' with wrong argument!"]}

filterAttribueSets :: [XsltAttribueSet] -> [QName] -> XmlTrees
filterAttribueSets [] _         = []
filterAttribueSets _ []         = []
filterAttribueSets aSets qNames = concat $ map (filterAttribueSets' aSets) qNames

filterAttribueSets' :: [XsltAttribueSet] -> QName -> XmlTrees
filterAttribueSets' as qn
    = case (lookup qn as) of
            Nothing -> []
            Just att -> concat $ map attValue att