[Haskell] XML Serialization and type constraints

[Tomasz Zielonka]

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