1{-# LANGUAGE BangPatterns #-}
2
3module Main (main) where
4
5import Control.Applicative
6import Control.Exception (bracket)
7import Control.Monad (forM_)
8import Data.Attoparsec.ByteString
9import RFC2616
10import System.Environment
11import System.IO
12import qualified Data.ByteString.Char8 as B
13
14refill :: Handle -> IO B.ByteString
15refill h = B.hGet h (80*1024)
16
17listy :: FilePath -> Handle -> IO ()
18listy file h = do
19  r <- parseWith (refill h) (many request) =<< refill h
20  case r of
21    Fail _ _ msg -> hPutStrLn stderr $ file ++ ": " ++ msg
22    Done _ reqs  -> print (length reqs)
23
24incrementy :: FilePath -> Handle -> IO ()
25incrementy file h = go (0::Int) =<< refill h
26 where
27   go !n is = do
28     r <- parseWith (refill h) request is
29     case r of
30       Fail _ _ msg -> hPutStrLn stderr $ file ++ ": " ++ msg
31       Done bs _req
32           | B.null bs -> do
33              s <- refill h
34              if B.null s
35                then print (n+1)
36                else go (n+1) s
37           | otherwise -> go (n+1) bs
38
39main :: IO ()
40main = do
41  args <- getArgs
42  forM_ args $ \arg ->
43    bracket (openFile arg ReadMode) hClose $
44      -- listy arg
45      incrementy arg
46