Rakka/Attachment.hs

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