module Network.IHttp.Tools
(
parseIter,
parseFull,
iterFinally,
iterTry,
showMethod,
showVersion,
asciiToUpper
)
where
import Control.ContStuff
import Control.Exception as Ex
import Data.Attoparsec.Char8 as P
import Data.ByteString as B
import Data.ByteString.Char8 ()
import Data.Char
import Data.Enumerator as E
import Data.List as L
import Network.IHttp.Types
import Text.Printf
asciiToUpper :: Char -> Char
asciiToUpper c
| c >= 'a' && c <= 'z' = chr $ ord c 0x20
| otherwise = c
iterFinally :: Monad m => Iteratee a m b -> Iteratee a m c -> Iteratee a m b
iterFinally c d = do
mRes <- catchError (Right <$> c) (return . Left)
case mRes of
Left err -> d >> throwError err
Right res -> res <$ d
iterTry :: MonadIO m => IO b -> Iteratee a m b
iterTry c = do
mRes <- liftIO (Ex.try c)
case mRes of
Left err -> throwError (err :: Ex.SomeException)
Right res -> return res
parseIter ::
(Ex.Exception ex, Monad m) =>
Parser b -> (String -> ex) -> ByteString -> Iteratee a m b
parseIter parser ex str =
case parseFull parser str of
Left err -> throwError (ex err)
Right res -> return res
parseFull :: forall a. Parser a -> ByteString -> Either String a
parseFull parser str =
loop (parse parser str)
where
loop :: P.Result a -> Either String a
loop (Fail _ ctxs msg) = Left (printf "%s (%s)" (L.intercalate ": " ctxs) msg)
loop (Partial k) = loop (k B.empty)
loop (Done _ res) = Right res
showMethod :: HttpMethod -> ByteString
showMethod ConnectMethod = "CONNECT"
showMethod DeleteMethod = "DELETE"
showMethod GetMethod = "GET"
showMethod HeadMethod = "HEAD"
showMethod OptionsMethod = "OPTIONS"
showMethod PatchMethod = "PATCH"
showMethod PostMethod = "POST"
showMethod PutMethod = "PUT"
showMethod TraceMethod = "TRACE"
showMethod (XMethod str) = str
showVersion :: HttpVersion -> ByteString
showVersion Http1_0 = "HTTP/1.0"
showVersion Http1_1 = "HTTP/1.1"