{-# LANGUAGE OverloadedStrings, CPP #-}

module Network.Wai.Application.Classic.Conduit (
    byteStringToBuilder
  , toResponseSource
  , parseHeader
  ) where

import Control.Applicative
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB (byteString)
import Data.CaseInsensitive (CI(..), mk)
import Data.Conduit
import Data.Conduit.Attoparsec
import qualified Data.Conduit.List as CL
import Data.Word
import Network.HTTP.Types

----------------------------------------------------------------

byteStringToBuilder :: ByteString -> Builder
byteStringToBuilder = BB.byteString

----------------------------------------------------------------

#if MIN_VERSION_conduit(1,3,0)
toResponseSource :: SealedConduitT () ByteString IO ()
                 -> IO (ConduitT () (Flush Builder) IO ())
toResponseSource rsrc = do
    let src = unsealConduitT rsrc
    return $ src .| CL.map (Chunk . byteStringToBuilder)
#else
toResponseSource :: ResumableSource IO ByteString
                 -> IO (Source IO (Flush Builder))
toResponseSource rsrc = do
    (src,_) <- unwrapResumable rsrc
    return $ src $= CL.map (Chunk . byteStringToBuilder)
#endif

----------------------------------------------------------------

parseHeader :: ConduitM ByteString o IO RequestHeaders
parseHeader = sinkParser parseHeader'

parseHeader' :: Parser RequestHeaders
parseHeader' = stop <|> loop
  where
    stop = [] <$ (crlf <|> endOfInput)
    loop = (:) <$> keyVal <*> parseHeader'

type RequestHeader = (CI ByteString, ByteString)

keyVal :: Parser RequestHeader
keyVal = do
    key <- takeTill (wcollon==)
    _ <- word8 wcollon
    skipWhile (wspace ==)
    val <- takeTill (`elem` [wlf,wcr])
    crlf
    return (mk key, val)

crlf :: Parser ()
crlf = (cr >> (lf <|> return ())) <|> lf

cr :: Parser ()
cr = () <$ word8 wcr

lf :: Parser ()
lf = () <$ word8 wlf

wcollon :: Word8
wcollon = 58

wcr :: Word8
wcr = 13

wlf :: Word8
wlf = 10

wspace :: Word8
wspace = 32