<commit_before>-- | This is a simple benchmark containing some IO. This program runs as a HTTP
-- server on a given port. It responds by spamming big tables in the right size.
-- The request protocol for clients is:
--
-- > GET /rows/columns HTTP/1.1
--
-- For example,
--
-- > GET /1000/10 HTTP/1.1
--
-- The server then responds with an HTML table with the requested dimensions.
--
{-# LANGUAGE OverloadedStrings #-}
module BigTableServer where

import Prelude hiding (putStrLn)

import Control.Concurrent (forkIO)
import Data.Monoid (mappend)
import Control.Applicative ((<$>))
import Control.Monad (forever, mapM_)
import Network.Socket (listen, accept, sClose)
import Network (listenOn, PortID (PortNumber))
import System (getArgs)
import Data.Char (ord)

import Network.Socket.ByteString (recv, send, sendMany)
import qualified Data.ByteString as SB
import qualified Data.ByteString.Char8 as SBC
import qualified Data.ByteString.Lazy as LB

import Utf8Html hiding (main)

main :: IO ()
main = do
    port <- PortNumber . fromIntegral . read . head <$> getArgs
    socket <- listenOn port
    forever $ do
        (s, _) <- accept socket 
        forkIO (respond s)
  where
    respond s = do
        string <- recv s 1024
        let words = SB.split (fromIntegral $ ord ' ') string
            requestUrl = words !! 1
        case SB.split (fromIntegral $ ord '/') requestUrl of
            (_ : h : w : _) -> do
                let height = read $ SBC.unpack h
                    width = read $ SBC.unpack w
                    rows = [1 .. width]
                    matrix = replicate height rows
                _ <- send s $ "HTTP/1.1 200 OK\r\n"
                    `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
                    `mappend` "\r\n"
                sendMany s $ LB.toChunks $ bigTable matrix
            _ -> do
                _<- send s $ "HTTP/1.1 404 Not Found\r\n"
                    `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
                    `mappend` "\r\n"
                    `mappend` "<h1>Not Found</h1>\r\n"
                return ()
        sClose s<commit_msg>small tuning of bigtable server<commit_after>-- | This is a simple benchmark containing some IO. This program runs as a HTTP
-- server on a given port. It responds by spamming big tables in the right size.
-- The request protocol for clients is:
--
-- > GET /rows/columns HTTP/1.1
--
-- For example,
--
-- > GET /1000/10 HTTP/1.1
--
-- The server then responds with an HTML table with the requested dimensions.
--
{-# LANGUAGE OverloadedStrings #-}
module BigTableServer where

import Prelude hiding (putStrLn)

import Control.Concurrent (forkIO)
import Data.Monoid (mappend)
import Control.Applicative ((<$>))
import Control.Monad (forever, mapM_)
import Network.Socket (listen, accept, sClose)
import Network (listenOn, PortID (PortNumber))
import System (getArgs)
import Data.Char (ord)

import Network.Socket.ByteString (recv, send, sendMany)
import Network.Socket.ByteString.Lazy (sendAll)
import qualified Data.ByteString as SB
import qualified Data.ByteString.Char8 as SBC
import qualified Data.ByteString.Lazy as LB

import Utf8Html hiding (main)

main :: IO ()
main = do
    port <- PortNumber . fromIntegral . read . head <$> getArgs
    socket <- listenOn port
    forever $ do
        (s, _) <- accept socket 
        forkIO (respond s)
  where
    respond s = do
        string <- recv s 1024
        let words = SB.split (fromIntegral $ ord ' ') string
            requestUrl = words !! 1
        case SB.split (fromIntegral $ ord '/') requestUrl of
            (_ : h : w : _) -> do
                let height = read $ SBC.unpack h
                    width = read $ SBC.unpack w
                    rows = [1 .. width]
                    matrix = replicate height rows
                _ <- send s $ "HTTP/1.1 200 OK\r\n"
                    `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
                    `mappend` "\r\n"
                -- SM: Perhaps this ^^ could also be added directly to the
                -- builder.  Thus saving a system call and getting some more
                -- speed.
                sendAll s $ bigTable matrix
                -- SM: using `sendAll` makes it already a bit faster. However,
                -- currently we are still spending way too much time in the
                -- server part.
                --
                -- A simple optimization is in network-bytestring.Lazy
                --
                -- 
                -- sendAll :: Socket      -- ^ Connected socket
                --         -> ByteString  -- ^ Data to send
                --         -> IO ()
                -- sendAll sock bs = do
                --   sent <- send sock bs
                --   when (sent < L.length bs) $ sendAll sock (L.drop sent bs)
                --
                --                ^ here the the length is computed twice ^
                --                ( event worse: the lazy bytestring is forced
                --                  completely! )
                --
                -- a more efficient version is:
                -- ----------------------------
                --
                -- sendAll sock bs = do
                --   sent <- send sock bs
                --   let bs' = L.drop sent bs
                --   when (L.null bs') $ sendAll sock bs'
                --
            _ -> do
                _<- send s $ "HTTP/1.1 404 Not Found\r\n"
                    `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
                    `mappend` "\r\n"
                    `mappend` "<h1>Not Found</h1>\r\n"
                return ()
        sClose s
{'fraction_non_alphanumeric': 0.10722446827210406, 'fraction_numerical': 0.01124978027772895, 'mean_word_length': 1.5165855816010614, 'pattern_counts': {'":': 0, '<': 26, '<?xml version=': 0, '>': 21, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5777960', 'n_tokens_mistral': 1682, 'n_tokens_neox': 1560, 'n_words': 550}