Rakka/Attachment.hs

   1 module Rakka.Attachment
   2     ( Attachment(..)
   3     )
   4     where
   5 import           Control.Arrow
   6 import           Control.Arrow.ArrowList
   7 import           System.IO.Unsafe
   8 import           Text.XML.HXT.Arrow.ReadDocument
   9 import           Text.XML.HXT.Arrow.WriteDocument
  10 import           Text.XML.HXT.Arrow.XmlArrow
  11 import           Text.XML.HXT.DOM.TypeDefs
  12 import           Text.XML.HXT.DOM.XmlKeywords
  13
  14
  15 class Attachment t where
  16     serializeToXmlTree     :: (ArrowChoice a, ArrowXml a) => a t XmlTree
  17     deserializeFromXmlTree :: (ArrowChoice a, ArrowXml a) => a XmlTree t
  18
  19     serializeToString :: t -> String
  20     serializeToString attachment
  21         = unsafePerformIO $
  22           do [xmlStr] <- runX ( setErrorMsgHandler False fail
  23                                 >>>
  24                                 constA attachment
  25                                 >>>
  26                                 serializeToXmlTree
  27                                 >>>
  28                                 writeDocumentToString [ (a_indent, v_1) ]
  29                               )
  30              return xmlStr
  31
  32     deserializeFromString :: String -> t
  33     deserializeFromString source
  34         = unsafePerformIO $
  35           do [ret] <- runX ( setErrorMsgHandler False fail
  36                              >>>
  37                              readString [ (a_validate         , v_0)
  38                                         , (a_check_namespaces , v_1)
  39                                         , (a_remove_whitespace, v_0)
  40                                         ] source
  41                              >>>
  42                              deserializeFromXmlTree
  43                            )
  44              return ret