Util.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Network.HTTP.Client.Util
    ( hGetSome
    , (<>)
    , readDec
    , hasNoBody
    , fromStrict
    ) where

import Data.Monoid (Monoid, mappend)

import qualified Data.ByteString.Char8 as S8
#if MIN_VERSION_bytestring(0,10,0)
import Data.ByteString.Lazy (fromStrict)
#else
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as S
#endif

import qualified Data.Text as T
import qualified Data.Text.Read

#if MIN_VERSION_base(4,3,0)
import Data.ByteString (hGetSome)
#else
import GHC.IO.Handle.Types
import System.IO                (hWaitForInput, hIsEOF)
import System.IO.Error          (mkIOError, illegalOperationErrorType)

-- | Like 'hGet', except that a shorter 'ByteString' may be returned
-- if there are not enough bytes immediately available to satisfy the
-- whole request.  'hGetSome' only blocks if there is no data
-- available, and EOF has not yet been reached.
hGetSome :: Handle -> Int -> IO S.ByteString
hGetSome hh i
    | i >  0    = let
                   loop = do
                     s <- S.hGetNonBlocking hh i
                     if not (S.null s)
                        then return s
                        else do eof <- hIsEOF hh
                                if eof then return s
                                       else hWaitForInput hh (-1) >> loop
                                         -- for this to work correctly, the
                                         -- Handle should be in binary mode
                                         -- (see GHC ticket #3808)
                  in loop
    | i == 0    = return S.empty
    | otherwise = illegalBufferSize hh "hGetSome" i

illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize handle fn sz =
    ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)
    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(
    where
      msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []
#endif

infixr 5 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend

readDec :: Integral i => String -> Maybe i
readDec s =
    case Data.Text.Read.decimal $ T.pack s of
        Right (i, t)
            | T.null t -> Just i
        _ -> Nothing

hasNoBody :: S8.ByteString -- ^ request method
          -> Int -- ^ status code
          -> Bool
hasNoBody "HEAD" _ = True
hasNoBody _ 204 = True
hasNoBody _ 304 = True
hasNoBody _ i = 100 <= i && i < 200

#if !MIN_VERSION_bytestring(0,10,0)
{-# INLINE fromStrict #-}
fromStrict :: S.ByteString -> L.ByteString
fromStrict x = L.fromChunks [x]
#endif