Tools.hs

-- |
-- Module:     Network.IHttp.Tools
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  beta
--
-- Enumeratees and other tools.

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Network.IHttp.Tools
    ( -- * Parser tools
      parseIter,
      parseFull,

      -- * Iteratee tools
      iterFinally,
      iterTry,

      -- * Printing tools
      showMethod,
      showVersion,

      -- * Character tools
      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


-- | Fast ASCII version of 'toUpper'.

asciiToUpper :: Char -> Char
asciiToUpper c
    | c >= 'a' && c <= 'z' = chr $ ord c - 0x20
    | otherwise            = c


-- | Runs the first computation and then the second, even if the first
-- one throws an exception.  'Iteratee' version of 'Ex.finally'.

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


-- | Try the given 'IO' computation and turn IO exceptions into iteratee
-- exceptions ('Error').

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


-- | Fully parse a string with the given parser.  Throw an iteratee
-- error with the given error constructor, if it fails.

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


-- | Fully parse a string with the given parser.

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


-- | Turn a method into its corresponding HTTP string.

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


-- | Turn an HTTP version into its corresponding HTTP string.

showVersion :: HttpVersion -> ByteString
showVersion Http1_0 = "HTTP/1.0"
showVersion Http1_1 = "HTTP/1.1"