<commit_before>module ZuriHac.Plays.KeyVoting where

import qualified Data.HashMap.Strict as HMS
import qualified Data.HashSet as HS
import qualified System.Clock as Clock

import ZuriHac.Plays.Protocol
import ZuriHac.Plays.Prelude

type KeyGroup = Int

data KeysConfig = KeysConfig
  { kcPercentageRequired :: Double
  , kcKeyGroups :: HMS.HashMap KeyCode KeyGroup
  , kcSamplingRateMs :: Int
  , kcUserTimeoutMs :: Int
  }

type User = ByteString

data UserState = UserState
  { usPressedKeys :: HS.HashSet KeyCode
  , usReleasedKeys :: HS.HashSet KeyCode
  , usLastActive :: Clock.TimeSpec
  }

type UserStates = HMS.HashMap User UserState

processEvent :: Clock.TimeSpec -> UserStates -> User -> Event -> UserStates
processEvent now uss user evt = case HMS.lookup user uss of
  Nothing -> error ("processEvent: cound not find user " <> show user)
  Just us@UserState{usPressedKeys, usReleasedKeys} -> let
    us' = case evt of
      EventKeyPress kc -> us
        { usPressedKeys = HS.insert kc usPressedKeys
        , usReleasedKeys = HS.delete kc usReleasedKeys
        }
      EventKeyRelease kc -> us
        { usReleasedKeys = HS.insert kc usReleasedKeys }
    in HMS.insert user us'{usLastActive = now} uss

type KeyCount = Int

finishRound :: Clock.TimeSpec -> KeysConfig -> UserStates -> (UserStates, HS.HashSet KeyCode)
finishRound now kconf uss = let
  kcs :: HMS.HashMap KeyGroup (HMS.HashMap KeyCode KeyCount)
  kcs = foldl' (HMS.unionWith (HMS.unionWith (+))) mempty $ do
    UserState{usPressedKeys} <- HMS.elems uss
    kc <- HS.toList usPressedKeys
    Just kg <- return (HMS.lookup kc (kcKeyGroups kconf))
    return (HMS.singleton kg (HMS.singleton kc 1))
  numUsers = length $ do
    us <- HMS.elems uss
    guard (Clock.toNanoSecs (now - usLastActive us) < fromIntegral (kcUserTimeoutMs kconf * 1000))
  goodKcs = HS.fromList $ do
    kcs <- HMS.elems kcs
    let (kc, count) : _ = sortBy (comparing (Down . snd)) (HMS.toList kcs)
    guard (fromIntegral count / fromIntegral numUsers > kcPercentageRequired kconf)
    return kc
  uss' = HMS.fromList $ do
    (user, us) <- HMS.toList uss
    return
      ( user
      , us
          { usPressedKeys = usPressedKeys us `HS.difference` usReleasedKeys us
          , usReleasedKeys = mempty
          }
      )
  in (uss', goodKcs)<commit_msg>check that num users is not 0<commit_after>module ZuriHac.Plays.KeyVoting where

import qualified Data.HashMap.Strict as HMS
import qualified Data.HashSet as HS
import qualified System.Clock as Clock

import ZuriHac.Plays.Protocol
import ZuriHac.Plays.Prelude

type KeyGroup = Int

data KeysConfig = KeysConfig
  { kcPercentageRequired :: Double
  , kcKeyGroups :: HMS.HashMap KeyCode KeyGroup
  , kcSamplingRateMs :: Int
  , kcUserTimeoutMs :: Int
  }

type User = ByteString

data UserState = UserState
  { usPressedKeys :: HS.HashSet KeyCode
  , usReleasedKeys :: HS.HashSet KeyCode
  , usLastActive :: Clock.TimeSpec
  }

type UserStates = HMS.HashMap User UserState

processEvent :: Clock.TimeSpec -> UserStates -> User -> Event -> UserStates
processEvent now uss user evt = case HMS.lookup user uss of
  Nothing -> error ("processEvent: cound not find user " <> show user)
  Just us@UserState{usPressedKeys, usReleasedKeys} -> let
    us' = case evt of
      EventKeyPress kc -> us
        { usPressedKeys = HS.insert kc usPressedKeys
        , usReleasedKeys = HS.delete kc usReleasedKeys
        }
      EventKeyRelease kc -> us
        { usReleasedKeys = HS.insert kc usReleasedKeys }
    in HMS.insert user us'{usLastActive = now} uss

type KeyCount = Int

finishRound :: Clock.TimeSpec -> KeysConfig -> UserStates -> (UserStates, HS.HashSet KeyCode)
finishRound now kconf uss = let
  kcs :: HMS.HashMap KeyGroup (HMS.HashMap KeyCode KeyCount)
  kcs = foldl' (HMS.unionWith (HMS.unionWith (+))) mempty $ do
    UserState{usPressedKeys} <- HMS.elems uss
    kc <- HS.toList usPressedKeys
    Just kg <- return (HMS.lookup kc (kcKeyGroups kconf))
    return (HMS.singleton kg (HMS.singleton kc 1))
  numUsers = length $ do
    us <- HMS.elems uss
    guard (Clock.toNanoSecs (now - usLastActive us) < fromIntegral (kcUserTimeoutMs kconf * 1000))
  goodKcs = HS.fromList $ do
    kcs <- HMS.elems kcs
    let (kc, count) : _ = sortBy (comparing (Down . snd)) (HMS.toList kcs)
    guard (numUsers > 0 && (fromIntegral count / fromIntegral numUsers > kcPercentageRequired kconf))
    return kc
  uss' = HMS.fromList $ do
    (user, us) <- HMS.toList uss
    return
      ( user
      , us
          { usPressedKeys = usPressedKeys us `HS.difference` usReleasedKeys us
          , usReleasedKeys = mempty
          }
      )
  in (uss', goodKcs)
{'fraction_non_alphanumeric': 0.09240994854202401, 'fraction_numerical': 0.002572898799313894, 'mean_word_length': 3.1763652641002684, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 30, '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': '1531205', 'n_tokens_mistral': 1615, 'n_tokens_neox': 1567, 'n_words': 447}