module Network.HTTP.Pony.Transformer.HTTP.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 Pipes (Producer)
import Pipes.Attoparsec (ParsingError(..))
import qualified Pipes.Attoparsec as PA
import Network.HTTP.Pony.Transformer.HTTP.Type
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 (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 (HttpMessage ByteString m r)))
parseMessage p errHandler = do
(r, body) <- runStateT (PA.parse message) p
pure (fmap (fmap (\(x, xs) -> ((x, xs), body))) r)