<commit_before>module MainLoop
(
  Put (..),
  handlePut,
  mainLoop,
  newState,
)
where

import Control.Concurrent.STM.TVar (TVar, newTVarIO)
import Control.Concurrent.STM.TBQueue (TBQueue, newTBQueueIO)
import Data.Aeson (Value (..))
import Data.Void (Void)
import Data.Text (Text)
import Data.Maybe (fromMaybe)

import qualified Data.HashMap.Strict as HashMap

-- Put is a command to put a value at a given path.
data Put = Put [Text] Value

data State = State
  { stValue :: TVar Value
  , stQueue :: TBQueue Put
  }

newState :: IO State
newState = do
  tvalue <- newTVarIO Null
  tqueue <- newTBQueueIO 128
  pure (State tvalue tqueue)

-- Execute a "put" operation.
handlePut :: Put -> Value -> Value
handlePut (Put path newValue) value = case path of
  [] -> newValue
  key : pathTail ->
    let
      putInner = handlePut (Put pathTail newValue)
      newDict = case value of
        Object dict -> HashMap.alter (Just . putInner . fromMaybe Null) key dict
        _notObject  -> HashMap.singleton key (putInner Null)
    in
      Object newDict

mainLoop :: State -> IO Void
mainLoop state =
  mainLoop state<commit_msg>Implement handler loop for puts<commit_after>module MainLoop
(
  Put (..),
  handlePut,
  mainLoop,
  newState,
)
where

import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TVar (TVar, newTVarIO, writeTVar)
import Control.Concurrent.STM.TBQueue (TBQueue, newTBQueueIO, readTBQueue)
import Data.Aeson (Value (..))
import Data.Void (Void)
import Data.Text (Text)
import Data.Maybe (fromMaybe)

import qualified Data.HashMap.Strict as HashMap

-- Put is a command to put a value at a given path.
data Put = Put [Text] Value

data State = State
  { stValue :: TVar Value
  , stQueue :: TBQueue Put
  }

newState :: IO State
newState = do
  tvalue <- newTVarIO Null
  tqueue <- newTBQueueIO 128
  pure (State tvalue tqueue)

-- Execute a "put" operation.
handlePut :: Put -> Value -> Value
handlePut (Put path newValue) value = case path of
  [] -> newValue
  key : pathTail ->
    let
      putInner = handlePut (Put pathTail newValue)
      newDict = case value of
        Object dict -> HashMap.alter (Just . putInner . fromMaybe Null) key dict
        _notObject  -> HashMap.singleton key (putInner Null)
    in
      Object newDict

mainLoop :: State -> IO Void
mainLoop state = go Null
  where
    go val = do
      put <- atomically $ readTBQueue (stQueue state)
      let newValue = handlePut put val
      -- TODO: Send out notifications here.
      atomically $ writeTVar (stValue state) newValue
      go newValue
{'fraction_non_alphanumeric': 0.09179307662388175, 'fraction_numerical': 0.002333722287047841, 'mean_word_length': 3.121794871794872, 'pattern_counts': {'":': 0, '<': 8, '<?xml version=': 0, '>': 17, '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': '1149902', 'n_tokens_mistral': 832, 'n_tokens_neox': 810, 'n_words': 288}