XML Serialization

{-# LANGUAGE OverloadedStrings #-}

import           Control.Monad.Trans.Resource
import           Data.Conduit
import           Data.Conduit.Binary
import           Data.Conduit.Blaze
import           Data.Text                    as T
import           Data.XML.Pickle
import           Data.XML.Types               as X
import           Text.XML
import           Text.XML.Stream.Parse
import           Text.XML.Unresolved          as U

main :: IO ()
main = do
        conduitEx
        putStrLn ""
        pickleEx
        putStrLn ""
        combinedEx

data Person = Person Text Int Text
            deriving (Eq, Show)

----

parsePerson = tagName "person" (requireAttr "age") $ \age -> do
        name <- content
        return $ Person name (read $ unpack age) ""

parsePeople = tagNoAttr "people" $ many parsePerson

conduitEx :: IO ()
conduitEx = do
        people <- runResourceT $
                parseFile def "people.xml" $$ force "people required" parsePeople
        print people


----

xpPerson :: PU [X.Node] Person
xpPerson =
    xpWrap (\((name, age), descr) -> Person name age descr)
           (\(Person name age descr) -> ((name, age), descr)) $
    xpElem "person"
        (xpPair
            (xpAttr "name" xpId)
            (xpAttr "age" xpPrim))
        (xpContent xpId)

people = [ Person "Dave" 27 "A fat thin man with long short hair."
         , Person "Jane" 21 "Lives in a white house with green windows."
         ]

pickleEx :: IO ()
pickleEx = do
        print $ pickle (xpRoot $ xpElemNodes "people" $ xpAll xpPerson) people

----

combinedEx :: IO ()
combinedEx = do
        let (X.NodeElement e) = pickle (xpRoot $ xpElemNodes "people" $ xpAll xpPerson) people
            doc               = X.Document (X.Prologue [] Nothing []) e []
        runResourceT $
            U.renderBuilder def doc $= builderToByteString $$ sinkFile "new-people.xml"