X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FAttachment.hs;h=eb7225d07e90dc520bc3e0b6080284352f763fc6;hb=HEAD;hp=06a947610433ea9bf02770110a31a9c3daef7eff;hpb=e85b652169f502cffe1f6f7f927d8990e9c11499;p=Rakka.git diff --git a/Rakka/Attachment.hs b/Rakka/Attachment.hs index 06a9476..eb7225d 100644 --- 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