module Network.Salvia.Handler.Printer
( hRequestPrinter
, hResponsePrinter
, hFlushHeaders
, hFlushHeadersOnly
, hFlushRequestHeaders
, hFlushResponseHeaders
, hFlushQueue
)
where
import Control.Applicative
import Control.Monad.State
import Network.Protocol.Http
import Network.Salvia.Interface
import Network.Salvia.Handler.Error
import System.IO
hRequestPrinter :: FlushM Request m => m ()
hRequestPrinter = flushHeaders forRequest >> flushQueue forRequest
hResponsePrinter :: FlushM Response m => m ()
hResponsePrinter = flushHeaders forResponse >> flushQueue forResponse
hFlushHeaders :: forall m d. (Show (Http d), HandleM m, QueueM m, MonadIO m, HttpM d m) => d -> m ()
hFlushHeaders _ =
do r <- http get :: m (Http d)
h <- handle
catchIO (hPutStr h (show r) >> hFlush h) ()
hFlushHeadersOnly :: forall m d. (Show (Http d), HandleM m, QueueM m, MonadIO m, HttpM d m) => d -> m ()
hFlushHeadersOnly _ =
do r <- http get :: m (Http d)
h <- handle
catchIO (hPutStr h (unlines . tail . lines $ show r) >> hFlush h) ()
hFlushRequestHeaders :: FlushM Request m => m ()
hFlushRequestHeaders = flushHeaders forRequest
hFlushResponseHeaders :: FlushM Response m => m ()
hFlushResponseHeaders = flushHeaders forResponse
hFlushQueue :: (QueueM m, HandleM m, SocketM m, MonadIO m) => m ()
hFlushQueue =
do s <- socket
h <- handle
q <- queue
flip catchIO () $
sequence_ (map (\(SendAction f) -> f (s, h)) q) >> hFlush h
where queue = dequeue >>= maybe (return []) ((<$> queue) . (:))