xml-pipe

This package process subset of XML and is still far from perfect, now.

Example programs

examples/indians.hs

extensions

• OverloadedStrings

• PackageImports

import Control.Monad
import "monads-tf" Control.Monad.Trans
import Data.Maybe
import Data.Pipe
import Data.Pipe.List
import Text.XML.Pipe

import qualified Data.ByteString.Char8 as BSC

littleIndians :: Int -> BSC.ByteString
littleIndians n = "<indians>" `BSC.append`
	BSC.pack (show n) `BSC.append` " little, " `BSC.append`
	BSC.pack (show $ n + 1) `BSC.append` " little, " `BSC.append`
	BSC.pack (show $ n + 2) `BSC.append` " little Indians" `BSC.append`
	"</indians>"

infiniteIndians :: [BSC.ByteString]
infiniteIndians = map littleIndians [1, 4 .. ]

xml :: [BSC.ByteString]
xml = "<?xml version='1.0'?><song>" : infiniteIndians

main :: IO ()
main = void . runPipe $ fromList xml
	=$= xmlEvent
	=$= convert fromJust
	=$= (xmlBegin >>= xmlNode)
	=$= takeP 8
	=$= printP

takeP :: Monad m => Int -> Pipe a a m ()
takeP 0 = return ()
takeP n = do
	mx <- await
	maybe (return ()) (\x -> yield x >> takeP (n - 1)) mx

convert :: Monad m => (a -> b) -> Pipe a b m ()
convert f = do
	mx <- await
	maybe (return ()) (\x -> yield (f x) >> convert f) mx

printP :: Show a => Pipe a () IO ()
printP = do
	mx <- await
	maybe (return ()) (\x -> lift (print x) >> printP) mx

examples/starttls.hs

It process STARTTLS of XMPP as client. The fllowings are only main part.

main :: IO ()
main = do
	h <- connectTo "localhost" (PortNumber 5222)
	BS.hPut h $ xmlString begin
	BS.hPut h $ xmlString startTls
	void . runPipe $ handleP h
		=$= xmlEvent
		=$= convert fromJust
		=$= (xmlBegin >>= xmlNodeUntil isProceed)
		=$= printP
	ca <- readCertificateStore ["cacert.sample_pem"]
	g <- cprgCreate <$> createEntropyPool :: IO SystemRNG
	(`run` g) $ do
		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca
		hlPut p $ xmlString begin
		void . runPipe $ handleP p
			=$= xmlEvent
			=$= convert fromJust
			=$= (xmlBegin >>= xmlNode)
			=$= printP