使用 hxt 插入基于父元素子元素的内容的元素

Question

我在使用 hxt 的概念上遇到了困难。

我有一个输入 xml 文档，其中包含如下片段：

      <Slip>
        <BNFY_NM>
          <snm>SURNAME</snm>
          <gvn_nm>GIVENAME</gvn_nm>
        </BNFY_NM>
        <SEC_BNFY_NM>
          <sec_snm>SMITH</sec_snm>
          <sec_gvn_nm>JANE</sec_gvn_nm>
        </SEC_BNFY_NM>
        ...

我需要插入另一个元素作为

<Slip>

的第一个子元素，如下所示：

      <Slip>
        <SlipSupplementary>
          <acct_nbr>SURNAME GIVENAME</acct_nbr>
        </SlipSupplementary>
        <BNFY_NM>
          <snm>SURNAME</snm>
          <gvn_nm>GIVENAME</gvn_nm>
        </BNFY_NM>
        ...

新元素的内容基于父节点的现有子元素。如果我只需要插入一个静态节点，我就可以让它工作，但我正在努力将其他节点的内容放入新节点。

testHXT ::  IO ()
testHXT = do
  runX $ readDocument [withValidate no] "input.xml"
         >>>
         processChildren (processSlips `when` isElem)
         >>>
         writeDocument [withIndent yes] "output.xml"
  return ()


processSlips :: ArrowXml a => a XmlTree XmlTree
processSlips = processTopDown (addAccountNo `when` isSlip)
    where isSlip = isElem >>> hasName "Slip"
          addAccountNo = replaceChildren (acctnoElement <+> getChildren)
          acctnoElement = mkelem "SlipSupplementary" [] [mkelem "dlr_acct_nbr" [] [txt $ L.concat [snm," ", gnm]]]
          snm = deep (isElem >>> hasName "snm" >>> getChildren >>> getText)
          gnm = deep (isElem >>> hasName "gnm" >>> getChildren >>> getText)

错误代码是这样的：

   * Couldn't match type `[Char]' with `Char'
      Expected: [Char]
        Actual: a0 (Data.Tree.NTree.TypeDefs.NTree XNode) String
    * In the expression: snm
      In the first argument of `concat', namely `[snm, gnm]'
      In the second argument of `($)', namely `concat [snm, gnm]'
    |
    |           acctnoElement = mkelem "SlipSupplementary" [] [mkelem "dlr_acct_nbr" [] [txt $ L.concat [snm,gnm]]]

我的感觉是，我需要让 snm 和 gnm 使用来自父节点的输入 XmlTree（就像 getChildren 正在生成的那样），但是我该怎么做？

[我已经尝试过如下的变体，但也遇到了困难，无论如何，我不确定如果我需要使用来自六个同级元素的内容，这是否可以很好地扩展：]

        acctnoElement = 
              isElem 
              >>>
              deep (isElem >>> hasName "snm" >>> getChildren >>> getText)
              >>>
              arr (\snm -> mkelem "SlipSupplementary" [] [mkelem "dlr_acct_nbr" [] [txt snm]])

Answer 1

以下似乎可以满足您的要求。请注意，

getText

已从

snm

和

gnm

的定义中删除：

processSlips :: ArrowXml a => a XmlTree XmlTree
processSlips = processTopDown (addAccountNo `when` isSlip)
    where isSlip = isElem >>> hasName "Slip"
          addAccountNo = replaceChildren (acctnoElement <+> getChildren)
          acctnoElement = mkelem "SlipSupplementary" [] 
                           [mkelem "dlr_acct_nbr" [] [snm, txt " ", gnm]]
          snm = deep (isElem >>> hasName "snm" >>> getChildren)
          gnm = deep (isElem >>> hasName "gvn_nm" >>> getChildren)

列表

[snm, txt " ", gnm]

表示一个简单的文本节点列表，当用于新元素的主体时，这些节点将连接在一起形成最终的主体文本。

如果您确实想使用

String

和

snm

的

gnm

值，您将找不到任何将

snm

或

gnm

转换为具体字符串的函数。您只需要通过箭头抽象来处理

String

值。

例如，如果您有一个基于非箭头

String

的函数，可以根据给定名称和姓氏创建可接受的全名：

fullName :: String -> String -> String
fullName snm gnm = map toUpper snm ++ ", " ++ gnm

您需要将其转换为箭头并使用箭头表达式应用它，例如：

fullNameText = (snm >>> getText) &&& (gnm >>> getText) 
               >>> arr2 fullName >>> mkText

您也可以使用箭头符号进行此类操作，但需要一些时间来适应：

{-# LANGUAGE Arrows #-}

fullNameText' = proc slip -> do
  s <- getText <<< snm -< slip
  g <- getText <<< gnm -< slip
  let fn = fullName s g
  mkText -< fn

请注意，在此表示法中，变量

s

、

g

和

fn

只是普通的

String

值。