<commit_before>module Network.Hakyll.SimpleServer
    ( simpleServer
    ) where

import Network
import Control.Monad (forever, mapM_)
import System.IO (Handle, hClose, hGetLine, hPutStr)
import System.Directory (doesFileExist)
import Control.Concurrent (forkIO)
import System.FilePath (takeExtension)
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M

import Text.Hakyll.Util

data Request = Request { requestMethod :: B.ByteString
                       , requestURI :: B.ByteString
                       , requestVersion :: B.ByteString
                       } deriving (Ord, Eq)

instance Show Request where
    show request =  (B.unpack $ requestMethod request) ++ " "
                 ++ (B.unpack $ requestURI request) ++ " "
                 ++ (B.unpack $ requestVersion request)

readRequest :: Handle -> IO Request
readRequest handle = do
    requestLine <- hGetLine handle
    let [method, uri, version] = map trim $ split " " requestLine
    return $ Request { requestMethod = B.pack method
                     , requestURI = B.pack uri
                     , requestVersion = B.pack version
                     }

data Response = Response { responseVersion :: B.ByteString
                         , responseStatusCode :: Int
                         , responsePhrase :: B.ByteString
                         , responseHeaders :: M.Map B.ByteString B.ByteString
                         , responseBody :: B.ByteString
                         } deriving (Ord, Eq)

instance Show Response where
    show response =  (B.unpack $ responseVersion response) ++ " "
                  ++ (show $ responseStatusCode response) ++ " "
                  ++ (B.unpack $ responsePhrase response)

defaultResponse :: Response
defaultResponse = Response { responseVersion = B.pack "HTTP/1.1"
                           , responseStatusCode = 0
                           , responsePhrase = B.empty
                           , responseHeaders = M.empty
                           , responseBody = B.empty
                           }

createResponse :: Request -> IO Response
createResponse request | requestMethod request == B.pack "GET" = createGetResponse request
                       | otherwise = return $ errorResponse 501 (B.pack "Not Implemented")

errorResponse :: Int -> B.ByteString -> Response
errorResponse statusCode phrase = defaultResponse
    { responseStatusCode = statusCode
    , responsePhrase = phrase
    , responseHeaders = M.singleton (B.pack "Content-Type") (B.pack "text/html")
    , responseBody = B.pack $  "<html> <head> <title>" ++ show statusCode ++ "</title> </head>"
                            ++ "<body> <h1>" ++ show statusCode ++ "</h1>\n"
                            ++ "<p>" ++ (B.unpack phrase) ++ "</p> </body> </html>"
    }

createGetResponse :: Request -> IO Response
createGetResponse request = do
    let uri = B.unpack (requestURI request)
    let fileName = "_site" ++ if uri == "/" then "/index.html"
                                            else B.unpack (requestURI request)
    exists <- doesFileExist fileName
    if exists then catch (create200 fileName) create500
              else return $ errorResponse 400 (B.pack "Not Found")
        where create200 fileName = do
                    body <- B.readFile fileName
                    let headers = [ (B.pack "Content-Length", B.pack $ show $ B.length body)
                                  ] ++ getMIMEHeader fileName<commit_msg>Not Found is 404, not 400.<commit_after>module Network.Hakyll.SimpleServer
    ( simpleServer
    ) where

import Network
import Control.Monad (forever, mapM_)
import System.IO (Handle, hClose, hGetLine, hPutStr)
import System.Directory (doesFileExist)
import Control.Concurrent (forkIO)
import System.FilePath (takeExtension)
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M

import Text.Hakyll.Util

data Request = Request { requestMethod :: B.ByteString
                       , requestURI :: B.ByteString
                       , requestVersion :: B.ByteString
                       } deriving (Ord, Eq)

instance Show Request where
    show request =  (B.unpack $ requestMethod request) ++ " "
                 ++ (B.unpack $ requestURI request) ++ " "
                 ++ (B.unpack $ requestVersion request)

readRequest :: Handle -> IO Request
readRequest handle = do
    requestLine <- hGetLine handle
    let [method, uri, version] = map trim $ split " " requestLine
    return $ Request { requestMethod = B.pack method
                     , requestURI = B.pack uri
                     , requestVersion = B.pack version
                     }

data Response = Response { responseVersion :: B.ByteString
                         , responseStatusCode :: Int
                         , responsePhrase :: B.ByteString
                         , responseHeaders :: M.Map B.ByteString B.ByteString
                         , responseBody :: B.ByteString
                         } deriving (Ord, Eq)

instance Show Response where
    show response =  (B.unpack $ responseVersion response) ++ " "
                  ++ (show $ responseStatusCode response) ++ " "
                  ++ (B.unpack $ responsePhrase response)

defaultResponse :: Response
defaultResponse = Response { responseVersion = B.pack "HTTP/1.1"
                           , responseStatusCode = 0
                           , responsePhrase = B.empty
                           , responseHeaders = M.empty
                           , responseBody = B.empty
                           }

createResponse :: Request -> IO Response
createResponse request | requestMethod request == B.pack "GET" = createGetResponse request
                       | otherwise = return $ errorResponse 501 (B.pack "Not Implemented")

errorResponse :: Int -> B.ByteString -> Response
errorResponse statusCode phrase = defaultResponse
    { responseStatusCode = statusCode
    , responsePhrase = phrase
    , responseHeaders = M.singleton (B.pack "Content-Type") (B.pack "text/html")
    , responseBody = B.pack $  "<html> <head> <title>" ++ show statusCode ++ "</title> </head>"
                            ++ "<body> <h1>" ++ show statusCode ++ "</h1>\n"
                            ++ "<p>" ++ (B.unpack phrase) ++ "</p> </body> </html>"
    }

createGetResponse :: Request -> IO Response
createGetResponse request = do
    let uri = B.unpack (requestURI request)
    let fileName = "_site" ++ if uri == "/" then "/index.html"
                                            else B.unpack (requestURI request)
    exists <- doesFileExist fileName
    if exists then catch (create200 fileName) create500
              else return $ errorResponse 404 (B.pack "Not Found")
        where create200 fileName = do
                    body <- B.readFile fileName
                    let headers = [ (B.pack "Content-Length", B.pack $ show $ B.length body)
                                  ] ++ getMIMEHeader fileName
{'fraction_non_alphanumeric': 0.09803076038522351, 'fraction_numerical': 0.0068995256576110395, 'mean_word_length': 1.8740190004130524, 'pattern_counts': {'":': 0, '<': 33, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2957732', 'n_tokens_mistral': 1761, 'n_tokens_neox': 1696, 'n_words': 514}