Re: [Haskell-cafe] hxt and pickler combinations

26 Jun 2008

      On Thu, Jun 26, 2008 at 04:11:58PM +0200, Andrea Rossato wrote:
...
Hello,
I'm using HXT for writing a Citation Style Language
(http://xbiblio.sourceforge.net) implementation in Haskell and I'm
trying to use the hxt pickler library to parse XML data contained in
elements that can be interleaved, that is to say, elements that can
appear in any order within other elements.
For instance:
<data>
  <string>ciao</string>
  <int>2</int>
</data>
or
<data>
  <int>2</int>
  <string>ciao</string>
</data>
are both permitted.
I'm not able to write picklers able to parse such kind of data. I
indeed noticed that this is not possible with interleaved elements,
but it is possible with attributes.
Thanks to a suggestion from Uwe (I contacted the HXT authors too,
since I thought it could be a non intended behaviour: instead it is,
in order to conform to the standard DTD validation), I came up with
this solution. I'm leaving it here too, for the archives.

This is a pickler that search the element in the contents and match it
without regard to the elements' order:

xpElem'  :: String -> PU a -> PU a
xpElem' name pa
    = PU { appPickle   = ( \ (a, st) ->
                           let
                           st' = appPickle pa (a, emptySt)
                           in
                           addCont (XN.mkElement (mkName name) (attributes st') (contents st')) st
                                                    )
         , appUnPickle = \ st -> fromMaybe (Nothing, st) (unpickleElement st)
         , theSchema   = scElem name (theSchema pa)
         }
      where
      unpickleElement st
          = do
            let t = contents st
            n <- mapM XN.getElemName t
            case elemIndex name (map qualifiedName n) of
              Nothing -> fail "element name does not match"
              Just i  -> do
                let cs = XN.getChildren (t !! i)
                al <- XN.getAttrl (t !! i)
                res <- fst . appUnPickle pa $ St {attributes = al, contents = cs}
                return (Just res, st {contents = take i t ++ drop (i + 1) t})

Andrea