[Hs-Generics] xml deserialization using generics?

[Hugh Perkins]

Well, figured out a solution to parsing xml.  It's not really pretty, but it
works.

Basically we just convert the incoming xml into a gread compatible format
then use gread :-D

If someone has a more elegant solution, please let me know.

For the moment, it will only work with Ints and Strings as the children, but
it's pretty easy to add new primitive data types, as long as it's pretty
easy to make them compatible with gread.  You just need to add additional
lines to the case statement in xmlToGShowFormat

Again, if someone has a more elegant solution, I'd enjoy seeing it,  but at
least this one works :-D

module ParseXml
   where

import IO
import Char
import List
import Maybe
import Data.Generics hiding (Unit)
import Text.XML.HXT.Arrow hiding (when)

data Config = Config{ name :: String, age :: Int }
--data Config = Config{ age :: Int }
   deriving( Data, Show, Typeable, Ord, Eq, Read )

createConfig = Config "qsdfqsdf" 3
--createConfig = Config 3
gshow' :: Data a => a -> String
gshow' t = fromMaybe (showConstr(toConstr t)) (cast t)

-- helper function from http://www.defmacro.org/ramblings/haskell-web.html
introspectData :: Data a => a -> [(String, String)]
introspectData a = zip fields (gmapQ gshow' a)
    where fields = constrFields $ toConstr a

-- function to create xml string from single-layer Haskell data type
xmlSerialize object = "<" ++ show(toConstr object) ++ ">" ++
   foldr (\(a,b) x  -> x ++ "<" ++ a ++ ">" ++ b ++ "</" ++ a ++ ">") "" (
introspectData object )
   ++ "</" ++ show(toConstr object) ++ ">"

-- parse xml to HXT tree, and obtain the value of node "fieldname"
-- returns a string
getValue xml fieldname | length(resultlist) > 0 = Just (head resultlist)
                                | otherwise = Nothing
    where resultlist = (runLA ( constA xml >>> xread >>> deep ( hasName
fieldname ) >>> getChildren >>> getText ))[]

-- parse templateobject to get list of field names
-- apply these to xml to get list of values
-- return (fieldnames list, value list)
xmlToGShowFormat :: Data a => String -> a -> String
xmlToGShowFormat xml templateobject =
   go
   where mainconstructorname = (showConstr $ toConstr templateobject)
         fields = constrFields $ toConstr templateobject
         values = map ( \fieldname -> getValue xml fieldname ) fields
         datatypes = gmapQ (dataTypeOf) templateobject
         constrs = gmapQ (toConstr) templateobject
         datatypereps = gmapQ (dataTypeRep . dataTypeOf) templateobject
         fieldtogshowformat (value,datatyperep) = case datatyperep of
            IntRep -> "(" ++ fromJust value ++ ")"
            _ -> show(fromJust value)
         formattedfieldlist = map (fieldtogshowformat) (zip values
datatypereps)
         go = "(" ++ mainconstructorname ++ " " ++ (concat $ intersperse " "
formattedfieldlist ) ++ ")"

xmlDeserialize xml templateobject = fst $ head $ gread( xmlToGShowFormat xml
templateobject)

dotest = xmlDeserialize (xmlSerialize createConfig) createConfig :: Config
dotest' = xmlDeserialize ("<Config><age>12</age><name>test
name!</name></Config>") createConfig :: Config
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/generics/attachments/20070702/e6ddd8f6/attachment.htm