Rakka/Attachment.hs

   1 {-# LANGUAGE
   2     TypeOperators
   3   , UnicodeSyntax
   4   #-}
   5 module Rakka.Attachment
   6     ( Attachment(..)
   7     )
   8     where
   9 import Control.Arrow
  10 import Control.Arrow.ArrowList
  11 import Control.Arrow.ListArrow
  12 import Control.Arrow.Unicode
  13 import System.IO.Unsafe
  14 import Text.XML.HXT.Arrow.ReadDocument
  15 import Text.XML.HXT.Arrow.WriteDocument
  16 import Text.XML.HXT.Arrow.XmlArrow
  17 import Text.XML.HXT.Arrow.XmlState
  18 import Text.XML.HXT.DOM.TypeDefs
  19
  20 class Attachment τ where
  21     serializeToXmlTree     ∷ (ArrowChoice (⇝), ArrowXml (⇝)) ⇒ τ ⇝ XmlTree
  22     deserializeFromXmlTree ∷ (ArrowChoice (⇝), ArrowXml (⇝)) ⇒ XmlTree ⇝ τ
  23
  24     -- FIXME: String? Am I okay with that?
  25     serializeToString ∷ τ → String
  26     serializeToString attachment
  27         = do [xmlStr] ← runLA ( constA attachment
  28                                 ⋙
  29                                 serializeToXmlTree
  30                                 ⋙
  31                                 writeDocumentToString [ withIndent yes ]
  32                               ) ()
  33              return xmlStr
  34
  35     deserializeFromString ∷ String → τ
  36     deserializeFromString source
  37         = unsafePerformIO $
  38           do [ret] ← runX ( setErrorMsgHandler False fail
  39                             ⋙
  40                             readString [ withValidate        no
  41                                        , withCheckNamespaces yes
  42                                        , withRemoveWS        yes
  43                                        ] source
  44                             ⋙
  45                             deserializeFromXmlTree
  46                           )
  47              return ret