<commit_before>{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Hashable
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.ByteString.Lazy.Char8 as BSLC8
import Control.Monad.IO.Class

import Database.Redis
import Snap

-- TODO does it handle utf8?
-- FIXME Unable to add a jobb when the queue is empty and a worker is requesting a Job

main :: IO ()
main = do
    conn <- connect defaultConnectInfo
    quickHttpServe $ site conn


site :: Connection -> Snap ()
site conn =
    route [ ("jobs", method POST $ addJob conn)
          , ("jobs/:jobId", method GET $ getJob conn)
          , ("requestJob", method GET $ requestJob conn)
          ]


getJob :: Connection -> Snap ()
getJob conn = do
    Just jobId <- getParam "jobId"
    response <- liftIO $ runRedis conn $ hget "job:" jobId
    case response of (Right (Just input)) -> writeBS input


requestJob :: Connection -> Snap ()
requestJob conn = do
    response <- liftIO $ runRedis conn $ brpoplpush "notcompleted" "inprogress" 60 -- TODO handle timeout properly
    case response of (Right (Just jobId)) -> writeBS jobId
<commit_msg>Removes blocking requestJob<commit_after>{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Hashable
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.ByteString.Lazy.Char8 as BSLC8
import Control.Monad.IO.Class

import Database.Redis
import Snap

-- TODO does it handle utf8?
-- FIXME Unable to add a jobb when the queue is empty and a worker is requesting a Job

main :: IO ()
main = do
    conn <- connect defaultConnectInfo
    quickHttpServe $ site conn


site :: Connection -> Snap ()
site conn =
    route [ ("jobs", method POST $ addJob conn)
          , ("jobs/:jobId", method GET $ getJob conn)
          , ("requestJob", method GET $ requestJob conn)
          ]


getJob :: Connection -> Snap ()
getJob conn = do
    Just jobId <- getParam "jobId"
    response <- liftIO $ runRedis conn $ hget "job:" jobId
    case response of (Right (Just input)) -> writeBS input


requestJob :: Connection -> Snap ()
requestJob conn = do
    response <- liftIO $ runRedis conn $ rpoplpush "notcompleted" "inprogress"
    case response of (Right (Just jobId)) -> writeBS jobId
                     (Right Nothing) -> notFound ""
                     (Left message) -> serverError message


{'fraction_non_alphanumeric': 0.09693877551020408, 'fraction_numerical': 0.00510204081632653, 'mean_word_length': 3.042955326460481, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1814668', 'n_tokens_mistral': 706, 'n_tokens_neox': 670, 'n_words': 262}