HXT xpickle (de)serialising between attribute values and value constructors

I'm trying to write an xpickle which serialises the value constructors of some type into XML attribute values of a specific attribute and de-serialises the XML attribute values back into value constructors of the type.

I have the follow data:

module Main where

import Text.XML.HXT.Core

newtype Things = Things [Thing]
data Thing = Thing (Maybe Property)
data Property = A | B

someThings :: Things
someThings = Things [ Thing (Just A)
                    , Thing Nothing
                    , Thing (Just B)
                    ]

And I'd like to serialise this into something like:

<things>
  <thing property="a" />
  <thing />
  <thing property="b" />
</things>

Here's the approach I'm taking:

instance XmlPickler Things where
  xpickle = xpWrap ( \things -> Things things , \(Things things) -> things ) $
            xpElem "things" $
            xpThings

xpThings :: PU [Thing]
xpThings = xpList xpickle

instance XmlPickler Thing where
  xpickle = xpElem "thing" $
            xpWrap ( \p -> Thing p , \(Thing p) -> p ) $
            xpProperty

xpProperty :: PU (Maybe Property)
xpProperty = xpOption $ xpAttr "property" xpPropertyValue

xpPropertyValue :: PU Property
xpPropertyValue = xpAlt tag ps
  where
    tag A = 1
    tag B = 2
    ps = [ xpTextAttr "a"
         , xpTextAttr "b"
         ]

main :: IO ()
main = do
  putStrLn $ showPickled [ withIndent yes ] someThings
  return ()

Here, xpProperty creates or reads an @property attribute and then uses xpPropertyValue to work out the value. xpPropertyValue determines the value depending on the value constructor of the value: A gives "a" and B gives "b" and the values are constructed using the xpTextAttr function. The problem here is that xpTextAttr is String -> PU String and I'm trying to use it where I need a PU Property. But I can't work out an alternative way of generating a PU Property value that's dependent on the value constructor of a Property value.

Solution

This isn't using xpTextAttr correctly. First of all its first parameter should be the attribute name "property" and secondly, it returns the text it matches.

You want to return the constructor A or B respectively.

You need to use xpWrap to specify the mapping (both ways) between the text contents of the property ("a" or "b") and those constructors. And the tags are 0-based I believe, so 0 and 1.

where
  tag A = 0
  tag B = 1
  ps = [ xpWrap (const A,const "a") $ xpTextAttr "property"
       , xpWrap (const B,const "b") $ xpTextAttr "property"
       ]

Then the call to xpAttr is wrong. Honestly I'm not sure what xpAttr is for, something to do with qualified names. In fact sufficient code for xpProperty is

xpProperty :: PU (Maybe Property)
xpProperty = xpOption $ xpPropertyValue