Resurrection from bitrot

[Rakka.git] / Rakka / Attachment.hs

diff --git a/Rakka/Attachment.hs b/Rakka/Attachment.hs
index 06a947610433ea9bf02770110a31a9c3daef7eff..eb7225d07e90dc520bc3e0b6080284352f763fc6 100644 (file)
--- a/Rakka/Attachment.hs
+++ b/Rakka/Attachment.hs
@@ -1,46 +1,47 @@
+{-# 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