A little demonstration of HXT and Lenses including a full worked example to show how to pickle an involved data structure to XML.

LensHXTPickle.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}

{- A little demonstration of HXT and Lenses -}

module Main where

import Control.Arrow
import Control.Lens
import Control.Monad
import Data.Char
import Text.XML.HXT.Core

{- Setup the framework; skip to "sample application" -}
data PickleBuilder inputT dataT ctorA ctorB = PickleBuilder {
  _pbConstructorMangler :: dataT -> ctorA -> Either String ctorB,
  _pbReader :: inputT -> dataT,
  _pbPickle :: PU dataT
  }

normalPB :: (d -> a -> b) -> (i -> d) -> PU d -> PickleBuilder i d a b
normalPB mgl = PickleBuilder (\d c -> Right (mgl d c))

infix  6 ~@~
infixr 2 >@>

(~@~) :: Getter s c -> PU c -> PickleBuilder s c (c -> b) b
lns ~@~ puc = normalPB (\c f -> f c) (^.lns) puc

(>@>) :: PickleBuilder i d a b
         -> PickleBuilder i d' b c -> PickleBuilder i (d, d') a c
(PickleBuilder ls la lc) >@> (PickleBuilder rs ra rc) =
  PickleBuilder (\(lC, rC) -> ls lC >=> rs rC) (la &&& ra) (xpPair lc rc)

withConstructor :: ctor -> PickleBuilder s d ctor s -> PU s
withConstructor ctor (PickleBuilder cfunc rdfunc puc) =
  xpWrapEither (fromPairs, rdfunc) puc
  where
    fromPairs x = cfunc x ctor

{- sample application: imagine a simple pet registry for an animal shelter or
   veterinary practice -}

data ContactInfo = ContactInfo {
  _ciName :: String,
  _ciStreet :: String,
  _ciCity :: String,
  _ciProvince :: String,
  _ciPostalCode :: String
  } deriving (Eq, Show)
makeFields ''ContactInfo

data PetType = Cat | Dog | Cavy | Rabbit
             deriving (Enum, Eq, Ord, Read, Show)

data AnimalRegistration = AnimalRegistration {
  _arPetType :: PetType,
  _arPetName :: String,
  _arOwner :: ContactInfo}
makeFields ''AnimalRegistration

data AnimalRegistry = AnimalRegistry [AnimalRegistration]

{-
   Now let's turn those data structures into XML.
   Most of the XML will be sane, but let's imagine some weirdness
   in the ContactInfo xml to show how flexible the PickleBuilder
   stuff is. Say, a requirement to encode the city and province as
   <city province="Province">City</city>
-}

instance XmlPickler PetType where
  xpickle = xpWrapMaybe (readMaybe, show >>> map toLower) xpText
    where
      readMaybe s = do {(x,""):_ <- return (reads $ capFirst s); return x}
      capFirst [] = []
      capFirst (x:xs) = toUpper x : xs

instance XmlPickler ContactInfo where
  xpickle = xpElem "contact-info" $ withConstructor ContactInfo $
            name   ~@~ xpElem "name" xpText >@>
            street ~@~ xpElem "street" xpText >@>
            normalPB (\c f -> uncurry (flip f) c) ((^.province) &&& (^.city))
                     (xpElem "city" $ xpPair (xpTextAttr "province") xpText) >@>
            postalCode ~@~ xpElem "postal" xpText

instance XmlPickler AnimalRegistration where
  xpickle = xpElem "registration" $ withConstructor AnimalRegistration $
            petType ~@~ xpAttr "type" xpickle    >@>
            petName ~@~ xpElem "pet-name" xpText >@>
            owner   ~@~ xpickle

instance XmlPickler AnimalRegistry where
  xpickle = xpWrap (AnimalRegistry, \(AnimalRegistry a) -> a)
                   (xpElem "animal-registry" $ xpList xpickle)

tstPet :: AnimalRegistration
tstPet  = AnimalRegistration Cavy "Chancy" $
          ContactInfo "Bob Jones"
                      "123 Bob St."
                      "Young America" "MN" "55555"
tstPet2 :: AnimalRegistration
tstPet2 = AnimalRegistration Cat "Fred" $
          ContactInfo "Jane Smith"
                      "112 Leon Blvd."
                      "Janesville" "WI" "53545"

main = (runX $ const (AnimalRegistry [tstPet,
                                      tstPet2]) ^>>
               xpickleDocument xpickle [withIndent yes] "-") >> return ()

{- Produces:
$ runghc LensHXT.hs
<?xml version="1.0" encoding="UTF-8"?>
<animal-registry>
  <registration type="cavy">
    <pet-name>Chancy</pet-name>
    <contact-info>
      <name>Bob Jones</name>
      <street>123 Bob St.</street>
      <city province="MN">Young America</city>
      <postal>55555</postal>
    </contact-info>
  </registration>
  <registration type="cat">
    <pet-name>Fred</pet-name>
    <contact-info>
      <name>Jane Smith</name>
      <street>112 Leon Blvd.</street>
      <city province="WI">Janesville</city>
      <postal>53545</postal>
    </contact-info>
  </registration>
</animal-registry>

-}