On Tue, Aug 24, 2004 at 07:35:46PM +0100, Simon D. Foster wrote:
I'm trying to implement an extensible XML De/Serializer in Haskell for use with SOAP and XML Schema (using the Haskell XML Toolbox). The idea is you have a type-class, which is instantiated for each type you want to encode/de-encode. This class (atm) takes the form;
class XMLSerializer a where encodeElements :: NamespaceTable -> Flags -> a -> [XmlFilter] encodeAttributes :: NamespaceTable -> Flags -> a -> [XmlFilter] encodeTree :: NamespaceTable -> String -> Flags -> a -> XmlFilter encodeTrees :: NamespaceTable -> String -> Flags -> a -> [XmlFilter]
decodeAttribute :: String -> XmlTree -> Maybe a decodeElement :: XmlTree -> Maybe a decodeTree :: XmlTree -> Maybe a decodeTrees :: XmlTrees -> Maybe a
(and a few default instances)
This type-class can then be used recursively to build XML representations of Haskell data.
I now want to expand this system to make is more extensible. For starters, to make it useful with SOAP, I need to add optional explicit typing of data. To this end I have another class; XSDType, which stores the XSD equivalent name and name-space for a particular Haskell type. This is what is used to add explicit type data to the XML documents. Adding this data involves adding an extra attribute to each node in the tree. More generally however each "Hook", which adds extra data at each node has type NamespaceTable -> Flags -> a -> ([XmlFilter], [XmlFilter]), where a is the type of the value.
However, this is where the problem comes. How do I go about expressing that a has a constraint XSDType a? I don't want to add this constraint to the Serializer class itself since an XML tree may not be typed by XSD. Somehow I need a way of adding extra constraints to a dynamically.
Here is one possible solution. Below is a working implementation for a simpler class scheme. You should be able to apply this to your problem, at least in case of adding XSD types, if not generally. {-# OPTIONS -fglasgow-exts #-} {-# OPTIONS -fallow-undecidable-instances #-} module B where import List import Data.Typeable -- Just to implement one of example mixins -- Mixin class - could have better name class Mixin a t where mixin :: t -> a -> (String -> String) -- Serializer class -- class Serializer has an additional parameter t which will be used -- for passing a mixin to it. Also it is a subclass of Mixin a t, but -- it doesn't mean adding unneccesary constraints to Serializer - -- one of Mixin's implementations will be identity. -- -- It is important that encodePrim's implementations don't call -- directly to encodePrim, only to encode, which makes the -- mixin work. class Mixin a t => Serializer a t where encodePrim :: t -> a -> String encode :: Serializer a t => t -> a -> String encode t x = mixin t x (encodePrim t x) -- Serializer instances - I used undecidable instances here. instance Mixin Int t => Serializer Int t where encodePrim _ = show instance Mixin Char t => Serializer Char t where encodePrim _ = show instance (Serializer a t, Mixin [a] t) => Serializer [a] t where encodePrim t l = "[" ++ concat (intersperse ", " (map (encode t) l)) ++ "]" -- example Mixins data Id = Id instance Mixin a Id where mixin Id _ = id data TypeOf = TypeOf instance Typeable a => Mixin a TypeOf where mixin TypeOf t s = "(" ++ s ++ " :: " ++ show (typeOf t) ++ ")" instance Mixin a (String -> String) where mixin f a = f -- this one can be used for combining mixins instance (Mixin a x, Mixin a y) => Mixin a (x, y) where mixin (x, y) a = mixin x a . mixin y a -- some unTypeable type data T a = T a instance (Serializer a t, Mixin (T a) t) => Serializer (T a) t where encodePrim t (T a) = "(T " ++ encode t a ++ ")" Example uses: *B> putStrLn $ encode Id 'a' 'a' *B> putStrLn $ encode TypeOf 'a' ('a' :: Char) *B> putStrLn $ encode Id ([1..4] :: [Int]) [1, 2, 3, 4] *B> putStrLn $ encode TypeOf ([1..4] :: [Int]) ([(1 :: Int), (2 :: Int), (3 :: Int), (4 :: Int)] :: [Int]) *B> putStrLn $ encode (TypeOf, TypeOf) ([1..4] :: [Int]) (([((1 :: Int) :: Int), ((2 :: Int) :: Int), ((3 :: Int) :: Int), ((4 :: Int) :: Int)] :: [Int]) :: [Int]) *B> putStrLn $ encode Id (T "Hello") (T ['H', 'e', 'l', 'l', 'o']) *B> putStrLn $ encode TypeOf (T "Hello") <interactive>:1: No instances for (Typeable (T [Char]), Show (IO ())) arising from use of `encode' at <interactive>:1 In the second argument of `($)', namely `encode TypeOf (T "Hello")' In the definition of `it': it = putStrLn $ (encode TypeOf (T "Hello")) <interactive>:1: No instances for (Typeable (T [Char]), Show (IO ())) arising from use of `print' at <interactive>:1 In a 'do' expression: print it I hope that helps, Best regards, Tom -- .signature: Too many levels of symbolic links