<commit_before>{-# LANGUAGE CPP                   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
module System.Monitoring
       ( monitoring
       , signalEvent
       , Monitor(..)
       , Event(..)
       , EventStream
       ) where

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Trans

import Data.Aeson
import Data.Aeson.TH
import Data.HashMap.Strict as HM
import Data.Text

import Network
import Network.WebSockets
import Yesod hiding (Update, Request)
import Yesod.Static

type GroupId = Text
type CounterId = Text

data Event = Update GroupId Object
           | Remove GroupId
              deriving Show

$(deriveJSON id ''Event)

type EventStream = TChan Event

waitForEvent :: EventStream -> IO Event
waitForEvent = atomically . readTChan

signalEvent :: Monitor -> Event -> IO ()
signalEvent Monitor {..} (Update cid val)
  = atomically $ do
      writeTChan signal (Update cid val)
      modifyTVar' cached $ HM.insert cid val

sendEvent :: Event -> WebSockets Hybi00 ()
sendEvent = send . DataMessage . Text . encode

app :: Monitor -> Request -> WebSockets Hybi00 ()
app Monitor {..} req = do
  acceptRequest req
  (ch', cur) <- liftIO $ atomically $
       (,) <$> dupTChan signal <*> readTVar cached
  mapM_ (sendEvent . uncurry Update) (toList cur)
  forever $ sendEvent =<< liftIO (waitForEvent ch')

eventServer :: Monitor -> IO ()
eventServer m = runServer "0" 4000 (app m)<commit_msg>~ Use WebSocketsData class.<commit_after>{-# LANGUAGE CPP                   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
module System.Monitoring
       ( monitoring
       , signalEvent
       , Monitor(..)
       , Event(..)
       , EventStream
       ) where

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Trans

import Data.Aeson
import Data.Aeson.TH
import Data.HashMap.Strict as HM
import Data.Text

import Network
import Network.WebSockets
import Yesod hiding (Update, Request)
import Yesod.Static

type GroupId = Text
type CounterId = Text

data Event = Update GroupId Object
           | Remove GroupId
              deriving Show

$(deriveJSON id ''Event)

instance WebSocketsData Event where
  toLazyByteString = encode
  fromLazyByteString = error "event not receivable"

type EventStream = TChan Event

waitForEvent :: EventStream -> IO Event
waitForEvent = atomically . readTChan

signalEvent :: Monitor -> Event -> IO ()
signalEvent Monitor {..} (Update cid val)
  = atomically $ do
      writeTChan signal (Update cid val)
      modifyTVar' cached $ HM.insert cid val

app :: Monitor -> Request -> WebSockets Hybi00 ()
app Monitor {..} req = do
  acceptRequest req
  (ch', cur) <- liftIO $ atomically $
       (,) <$> dupTChan signal <*> readTVar cached
  mapM_ (sendTextData . uncurry Update) (toList cur)
  forever $ sendTextData =<< liftIO (waitForEvent ch')

eventServer :: Monitor -> IO ()
eventServer m = runServer "0" 4000 (app m)
{'fraction_non_alphanumeric': 0.10092307692307692, 'fraction_numerical': 0.004923076923076923, 'mean_word_length': 3.0036945812807883, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 20, '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': '739072', 'n_tokens_mistral': 1022, 'n_tokens_neox': 988, 'n_words': 302}