module Network.Salvia.Handler.Parser
( hRequestParser
, hResponseParser
, hParser
, readNonEmptyLines
)
where
import Control.Applicative
import Control.Monad.State hiding (sequence)
import Data.Traversable
import Network.Protocol.Http
import Network.Salvia.Interface
import Network.Salvia.Handler.Error
import Prelude hiding (sequence)
import System.IO
hRequestParser
:: (HandleM m, RawHttpM Request m, HttpM Request m, MonadIO m)
=> Int
-> (String -> m a)
-> m a
-> m (Maybe a)
hRequestParser = hParser pt parseRequest
where pt x = do request (put x)
rawRequest (put x)
hResponseParser
:: (HandleM m, RawHttpM Response m, HttpM Response m, MonadIO m)
=> Int
-> (String -> m a)
-> m a
-> m (Maybe a)
hResponseParser = hParser pt parseResponse
where pt x = do response (put x)
rawResponse (put x)
hParser
:: (HandleM m, MonadIO m)
=> (Http d -> m b)
-> (String -> Either String (Http d))
-> Int
-> (String -> m a)
-> m a
-> m (Maybe a)
hParser action parse _ onfail onsuccess =
do h <- handle
mmsg <-
liftM join
. flip catchIO Nothing
. fmap Just
$ do hSetBuffering h (BlockBuffering (Just (64*1024)))
Just <$> readNonEmptyLines h
let hndl = (onfail . show) `either` (\x -> action x >> onsuccess)
sequence (hndl . parse <$> mmsg)
readNonEmptyLines :: Handle -> IO String
readNonEmptyLines h = ($"") <$> f
where
f = do l <- hGetLine h
let lf = showChar '\n'
if null l || l == "\r"
then return lf
else ((showString l . lf) .) <$> f