[Haskell-cafe] XmlSerializer.deserialize?

[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.

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/haskell-cafe/attachments/20070701/d23c28d9/attachment.htm