+{-# LANGUAGE
+ TypeOperators
+ , UnicodeSyntax
+ #-}
module Rakka.Attachment
( Attachment(..)
)
where
+import Control.Arrow
+import Control.Arrow.ArrowList
+import Control.Arrow.ListArrow
+import Control.Arrow.Unicode
+import System.IO.Unsafe
+import Text.XML.HXT.Arrow.ReadDocument
+import Text.XML.HXT.Arrow.WriteDocument
+import Text.XML.HXT.Arrow.XmlArrow
+import Text.XML.HXT.Arrow.XmlState
+import Text.XML.HXT.DOM.TypeDefs
-import Control.Arrow
-import Control.Arrow.ArrowList
-import System.IO.Unsafe
-import Text.XML.HXT.Arrow.ReadDocument
-import Text.XML.HXT.Arrow.WriteDocument
-import Text.XML.HXT.Arrow.XmlArrow
-import Text.XML.HXT.Arrow.XmlIOStateArrow
-import Text.XML.HXT.DOM.TypeDefs
-import Text.XML.HXT.DOM.XmlKeywords
+class Attachment τ where
+ serializeToXmlTree ∷ (ArrowChoice (⇝), ArrowXml (⇝)) ⇒ τ ⇝ XmlTree
+ deserializeFromXmlTree ∷ (ArrowChoice (⇝), ArrowXml (⇝)) ⇒ XmlTree ⇝ τ
-
-class Attachment t where
- serializeToXmlTree :: (ArrowChoice a, ArrowXml a) => a t XmlTree
- deserializeFromXmlTree :: (ArrowChoice a, ArrowXml a) => a XmlTree t
-
- serializeToString :: t -> String
+ -- FIXME: String? Am I okay with that?
+ serializeToString ∷ τ → String
serializeToString attachment
- = unsafePerformIO $
- do [xmlStr] <- runX ( setErrorMsgHandler False fail
- >>>
- constA attachment
- >>>
+ = do [xmlStr] ← runLA ( constA attachment
+ ⋙
serializeToXmlTree
- >>>
- writeDocumentToString [ (a_indent, v_1) ]
- )
+ ⋙
+ writeDocumentToString [ withIndent yes ]
+ ) ()
return xmlStr
- deserializeFromString :: String -> t
+ deserializeFromString ∷ String → τ
deserializeFromString source
= unsafePerformIO $
- do [ret] <- runX ( setErrorMsgHandler False fail
- >>>
- readString [ (a_validate , v_0)
- , (a_check_namespaces , v_1)
- , (a_remove_whitespace, v_0)
- ] source
- >>>
- deserializeFromXmlTree
- )
+ do [ret] ← runX ( setErrorMsgHandler False fail
+ ⋙
+ readString [ withValidate no
+ , withCheckNamespaces yes
+ , withRemoveWS yes
+ ] source
+ ⋙
+ deserializeFromXmlTree
+ )
return ret