module Network.XmlPush.Simple (SimplePusher, SimplePusherArgs(..)) where
import "monads-tf" Control.Monad.Trans
import Control.Monad
import Data.Maybe
import Data.HandleLike
import Data.Pipe
import Text.XML.Pipe
import Network.XmlPush
import qualified Data.ByteString as BS
data SimplePusher h = SimplePusher
(Pipe () XmlNode (HandleMonad h) ())
(Pipe XmlNode () (HandleMonad h) ())
data SimplePusherArgs h = SimplePusherArgsNull
instance XmlPusher SimplePusher where
type NumOfHandle SimplePusher = One
type PusherArgs SimplePusher = SimplePusherArgs
generate (One h) _ = simplePusher h
readFrom (SimplePusher r _) = r
writeTo (SimplePusher _ w) = w
simplePusher :: HandleLike h => h -> HandleMonad h (SimplePusher h)
simplePusher h = return $ SimplePusher (readXml h) (writeXml h)
readXml :: HandleLike h => h -> Pipe () XmlNode (HandleMonad h) ()
readXml h = fromHandleLike h
=$= xmlEvent
=$= convert fromJust
=$= void (xmlNode [])
writeXml :: HandleLike h => h -> Pipe XmlNode () (HandleMonad h) ()
writeXml h = convert (xmlString . (: [])) =$= toHandleLike h
fromHandleLike :: HandleLike h => h -> Pipe () BS.ByteString (HandleMonad h) ()
fromHandleLike h = lift (hlGetContent h) >>= yield >> fromHandleLike h
toHandleLike :: HandleLike h => h -> Pipe BS.ByteString () (HandleMonad h) ()
toHandleLike h = await >>= maybe (return ()) ((>> toHandleLike h) . lift . hlPut h)