-- | Parser

module Network.HTTP.Pony.Parser where

import           Control.Applicative ((<|>))
import           Control.Monad.Trans.State.Strict (runStateT)
import           Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString.Char8 as Char
import           Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.CaseInsensitive as CI
import           Pipes (Producer)
import           Pipes.Attoparsec (ParsingError(..))
import qualified Pipes.Attoparsec as PA

import           Network.HTTP.Pony.Helper ((-))
import           Network.HTTP.Pony.Type
import           Prelude hiding ((-))

-- https://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2


startLine :: Parser ByteString
startLine = takeTill Char.isEndOfLine <* Char.endOfLine

requestLine :: Parser ByteString
requestLine = startLine

statusLine :: Parser ByteString
statusLine = startLine

headers :: Parser [Header]
headers = do
  many' header <* Char.endOfLine

token :: Parser ByteString
token = fmap B.pack - many1' (Char.letter_ascii <|> Char.char '-')

header :: Parser Header
header = do
  fieldName <- token
  Char.char ':'
  Char.skipSpace
  fieldValue <- takeTill Char.isEndOfLine
  Char.endOfLine
  pure (CI.mk fieldName, fieldValue)

message :: Parser (ByteString, [Header])
message = do
  Char.skipSpace
  (,) <$> startLine <*> headers

parseMessage :: (Monad m) => Producer ByteString m r
                          -> m a
                          -> m (Maybe (Either ParsingError (Message ByteString m r)))
parseMessage p errHandler = do
  (r, body) <- runStateT (PA.parse message) p

  pure - fmap (fmap (\(x, xs) -> (x, xs, body))) r