attoparsec notInClass

{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Main (main) where

import Criterion.Main

import Control.Applicative
import Data.Attoparsec.ByteString as P
import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)
import Data.ByteString (ByteString)
import Data.Word (Word8)
import Data.Attoparsec.ByteString.Char8 (isEndOfLine, isHorizontalSpace)

import Control.Exception (bracket)
import Control.Monad (forM_)
import Data.Attoparsec.ByteString
import qualified Data.ByteString as B

main = do 
  bs <- B.readFile "../attoparsec/examples/http-requests.txt"
  defaultMain
    [ bgroup "token" 
        [ bench "notInClass" $ nf (incrementy request_) bs
        , bench "by hand" $ nf (incrementy request) bs
        ]
        ]


-- incrementy :: FilePath -> Handle -> IO ()
incrementy p  = go (0::Int)  where
   go !n is = case parse p is of
       Fail _ _ msg -> error "chaos" -- hPutStrLn stderr $ file ++ ": " ++ msg
       Done bs _req
           | B.null bs ->  (n+1)
           | otherwise -> go (n+1) bs
           
is_token :: Word8 -> Bool
is_token w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w


isToken :: Word8 -> Bool
isToken w = w < 128 
  && w > 32
  && not (w > 57 && w < 65)
  && not (w > 90 && w < 94) 
  && w /=9
  && w /= 34
  && w /= 40
  && w /= 41
  && w /= 44
  && w /= 47
  && w /= 123
  && w /=125



--   w <= 127 

-- && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w

skipSpaces :: Parser ()
skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace

data Request = Request {
      requestMethod  :: ByteString
    , requestUri     :: ByteString
    , requestVersion :: ByteString
    } deriving (Eq, Ord, Show)

httpVersion :: Parser ByteString
httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)

requestLine :: Parser Request
requestLine = Request <$> (takeWhile1 isToken <* char8 ' ')
                      <*> (takeWhile1 (/=32) <* char8 ' ')
                      <*> (httpVersion <* endOfLine)


request_line :: Parser Request
request_line = Request <$> (takeWhile1 is_token <* char8 ' ')
                      <*> (takeWhile1 (/=32) <* char8 ' ')
                      <*> (httpVersion <* endOfLine)

data Header = Header {
      headerName  :: ByteString
    , headerValue :: [ByteString]
    } deriving (Eq, Ord, Show)

messageHeader :: Parser Header
messageHeader = Header
  <$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)
  <*> ((:) <$> (takeTill isEndOfLine <* endOfLine)
           <*> (many $ skipSpaces *> takeTill isEndOfLine <* endOfLine))

--
message_header :: Parser Header
message_header = Header
  <$> (P.takeWhile is_token <* char8 ':' <* skipWhile isHorizontalSpace)
  <*> ((:) <$> (takeTill isEndOfLine <* endOfLine)
           <*> (many $ skipSpaces *> takeTill isEndOfLine <* endOfLine))

           
request :: Parser (Request, [Header])
request = (,) <$> requestLine <*> many messageHeader <* endOfLine

request_ :: Parser (Request, [Header])
request_ = (,) <$> request_line <*> many message_header <* endOfLine

data Response = Response {
      responseVersion :: ByteString
    , responseCode    :: ByteString
    , responseMsg     :: ByteString
    } deriving (Eq, Ord, Show)

responseLine :: Parser Response
responseLine = Response <$> (httpVersion <* char8 ' ')
                        <*> (P.takeWhile isDigit_w8 <* char8 ' ')
                        <*> (takeTill isEndOfLine <* endOfLine)

response :: Parser (Response, [Header])
response = (,) <$> responseLine <*> many messageHeader <* endOfLine