haskellhxt

Using hxt to insert elements with contents based on children of the parent element

I'm struggling conceptually with using hxt.

I have an input xml document with a fragment like this:

      <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>
        ...

I need to insert another element as the first child of <Slip>, like this:


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

The new element has content based on the existing child elements of the parent node. I can get it working if I just need to insert a static node, but I am struggling to get the content of the other nodes into the new one.

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)

The error code is this:

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

My sense is that I need to make snm and gnm use input XmlTree's from the parent node (like what getChildren is producing), but how would I do that?

[I've tried variations like below, but have also run into a brick wall, and regardless, I'm not sure this will scale well if I need to use content from six sibling elements:]

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

  • The following seems to do what you want. Note that the getText has been removed from the definitions of snm and 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)

    The list [snm, txt " ", gnm] then represents a simple list of text nodes that, when used for the body of the new element, will be concatentated together to form the final body text.

    If you actually want to work with the String values of snm and gnm, you won't find any function that will convert snm or gnm to a concrete string. You need to work with the String values only through the arrow abstraction.

    For example, if you have a non-arrow String-based function that creates an acceptable full name from a given and last name:

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

    you'll need to convert it to an arrow and apply it using arrow expressions, like:

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

    You can also do this sort of manipulation with arrow notation, but it takes some getting used to:

    {-# LANGUAGE Arrows #-}

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

    Note that in this notation, the variables s, g, and fn are just plain String values.