-- |
-- Module:     Network.NetLines
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- Enumerator tools for working with text-based network protocols.

{-# LANGUAGE ScopedTypeVariables #-}

module Network.NetLines
    ( -- * Conversion to lines
      netLine,
      netLines,

      -- * Conversion to sparse lines
      netLineEmpty,
      netLinesEmpty,

      -- * Enumerators
      enumHandleTimeout
    )
    where

import qualified Data.ByteString as B
import Control.ContStuff
import Data.ByteString (ByteString)
import Data.Enumerator as E
import Data.Enumerator.Binary as EB
import Data.Word
import System.IO
import System.IO.Error as IOErr


-- | Enumerate from a handle with the given buffer size (first argument)
-- and timeout in milliseconds (second argument).  If the timeout is
-- exceeded an exception is thrown via 'throwError'.

enumHandleTimeout :: forall b m. MonadIO m =>
                     Int -> Int -> Handle -> Enumerator ByteString m b
enumHandleTimeout bufSize timeout h = loop
    where
    loop :: Enumerator ByteString m b
    loop (Continue k) = do
          mHaveInput <- liftIO $ IOErr.try (hWaitForInput h timeout)
          case mHaveInput of
            Left err
                | isEOFError err -> continue k
                | otherwise      -> throwError err
            Right False -> throwError $ userError "Handle timed out"
            Right True  -> do
                mStr <- liftIO $ IOErr.try (B.hGetNonBlocking h bufSize)
                str <- either throwError return mStr
                if B.null str
                  then continue k
                  else k (Chunks [str]) >>== loop
    loop step = returnI step


-- | Predicate whether the given byte is a line terminator (includes CR
-- and LF).

isEol :: Word8 -> Bool
isEol c = c == 10 || c == 13


-- | Predicate whether the given byte is an LF line terminator.

isNotEol :: Word8 -> Bool
isNotEol = not . isEol


-- | Savely read a line with the given maximum length.  If a longer line
-- is enumerated, the excess data is dropped in constant space.  Returns
-- 'Nothing' on EOF.
--
-- Please note that this function is very error-tolerant in the way it
-- handles line endings.  Both CR and LF are proper line terminators.
-- This function ignores empty lines.

netLine :: forall m r. Monad m => Int -> MaybeT r (Iteratee ByteString m) ByteString
netLine n =
    lift (EB.dropWhile isEol) >> netLine' n

    where
    netLine' :: Int -> MaybeT r (Iteratee ByteString m) ByteString
    netLine' 0 = B.empty <$ lift (EB.dropWhile isNotEol)
    netLine' n = do
        c <- liftF EB.head
        if isNotEol c
          then B.cons c <$> netLine' (n-1)
          else return B.empty


-- | Variant of 'netLine', which supports empty lines, useful for
-- protocols like HTTP, in which empty lines have a special meaning.
-- This function splits the input stream by LF characters while simply
-- ignoring CR characters.

netLineEmpty :: forall m. Monad m => Int -> Iteratee ByteString m (Maybe ByteString)
netLineEmpty maxLine =
    joinI $ E.map (B.filter (/= 13)) $$ evalMaybeT (netLineEmpty' maxLine)

    where
    netLineEmpty' :: forall r. Int -> MaybeT r (Iteratee ByteString m) ByteString
    netLineEmpty' 0 = B.empty <$ lift (EB.dropWhile (/= 10) >> EB.drop 1)
    netLineEmpty' n = do
        c <- liftF EB.head
        if c /= 10
          then B.cons c <$> netLineEmpty' (n-1)
          else return B.empty


-- | Convert a stream of bytes to a stream of lines with the given
-- maximum length.  Longer lines are silently truncated in constant
-- space.

netLines :: forall b m. Monad m => Int -> Enumeratee ByteString ByteString m b
netLines maxLen = loop
    where
    loop :: Enumeratee ByteString ByteString m b
    loop (Continue k) = do
        mLine <- evalMaybeT $ netLine maxLen
        case mLine of
          Just line -> k (Chunks [line]) >>== loop
          Nothing   -> k EOF >>== loop
    loop step = return step


-- | This is the same like 'netLines', but is based on 'netLinesEmpty'
-- to support empty lines.

netLinesEmpty :: forall b m. Monad m => Int -> Enumeratee ByteString ByteString m b
netLinesEmpty maxLen = loop
    where
    loop :: Enumeratee ByteString ByteString m b
    loop (Continue k) = do
        mLine <- netLineEmpty maxLen
        case mLine of
          Just line -> k (Chunks [line]) >>== loop
          Nothing   -> k EOF >>== loop
    loop step = return step