<commit_before>{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}

module Main (main) where
import Data.BERT (Term(..))
import Data.Maybe
import Data.Monoid ((<>))
import Data.String (fromString)
import Control.Monad (forM_)
import Control.Concurrent (newMVar, readMVar)
import qualified Network.WebSockets as WS

import Network.N2O
import Network.N2O.PubSub
import Data.IxSet as I


broadcastBinary message clients 
    = forM_ clients $ \(Entry {eConn}) -> WS.sendBinaryData eConn message

-- bar user = eval $ call "log" (user <> " joined") <>  call "addUser" user

    --WS.sendTextData connection $ "Welcome! Users: " `mappend` T.intercalate ", " (map fst s)
    -- talk connection state client
    --

main = do
    state <- newMVar newChannel
    putStrLn "Started"
    simple  "0.0.0.0" 9160 handle state
    print "ok"

loggedOff :: Maybe String
loggedOff = Nothing

sendMessage text = broadcastBinary $ eval $ call "log" $ fromString text

loggedOn state = toList . getGT loggedOff . coSet <$> readMVar state

handle state connection socketId loop [AtomTerm "LOGON", AtomTerm name]
    = do
        send connection $ call "log" "ahaha" <> call "joinSession" ""
        setState state socketId $ Just $ fromString name
        clients <- loggedOn state
        sendMessage (name <> " joined") clients
        let foo = concatMap ((\x -> "<li>" <> x <> "</li>") . fromJust . eUser) clients
        broadcastBinary (eval $ call "$('#users').html" $ fromString foo) clients
        loop
        
handle state _connection socketId loop [AtomTerm "MSG", AtomTerm text]
    = do
        clients <- loggedOn state
        sendMessage text clients
        print clients
        loop

handle _state _connection _  _loop _ = putStrLn "Protocol violation"

{-
             | not (prefix `T.isPrefixOf` WS.fromLazyByteString x) ->
                WS.sendTextData connection ("Wrong announcement" :: Text)
             | any ($ fst client) [T.null, T.any isPunctuation, T.any isSpace] ->
                WS.sendTextData connection ("Name cannot " `mappend`
                    "contain punctuation or whitespace, and " `mappend`
                    "cannot be empty" :: Text)
             | clientExists client clients ->
                WS.sendTextData connection ("User already exists" :: Text)
             | otherwise -> do
                liftIO $ modifyMVar_ state $ \s -> do
                    let s' = addClient client s
                    WS.sendTextData connection $ "Welcome! Users: " `mappend` T.intercalate ", " (map fst s)
                    broadcastBinary (bar $ BL.fromStrict $ encodeUtf8 $ fst client) s'
                    return s'<commit_msg>2 eval calls are merged into 1<commit_after>{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}

module Main (main) where
import Data.BERT (Term(..))
import Data.Maybe
import Data.Monoid ((<>))
import Data.String (fromString)
import Control.Monad (forM_)
import Control.Concurrent (newMVar, readMVar)
import qualified Network.WebSockets as WS

import Network.N2O
import Network.N2O.PubSub
import Data.IxSet as I


broadcastBinary message clients 
    = forM_ clients $ \(Entry {eConn}) -> WS.sendBinaryData eConn message

-- bar user = eval $ call "log" (user <> " joined") <>  call "addUser" user

    --WS.sendTextData connection $ "Welcome! Users: " `mappend` T.intercalate ", " (map fst s)
    -- talk connection state client
    --

main = do
    state <- newMVar newChannel
    putStrLn "Started"
    simple  "0.0.0.0" 9160 handle state
    print "ok"

loggedOff :: Maybe String
loggedOff = Nothing

sendMessage text = broadcastBinary $ eval $ call "log" $ fromString text

loggedOn state = toList . getGT loggedOff . coSet <$> readMVar state

handle state connection socketId loop [AtomTerm "LOGON", AtomTerm name]
    = do
        send connection $ call "log" "ahaha" <> call "joinSession" ""
        setState state socketId $ Just $ fromString name
        clients <- loggedOn state
        let foo = concatMap ((\x -> "<li>" <> x <> "</li>") . fromJust . eUser) clients
        broadcastBinary (eval $ call "$('#users').html" (fromString foo) <> call "log" (fromString name <> " joined")) clients
        loop
        
handle state _connection socketId loop [AtomTerm "MSG", AtomTerm text]
    = do
        clients <- loggedOn state
        sendMessage text clients
        print clients
        loop

handle _state _connection _  _loop _ = putStrLn "Protocol violation"

{-
             | not (prefix `T.isPrefixOf` WS.fromLazyByteString x) ->
                WS.sendTextData connection ("Wrong announcement" :: Text)
             | any ($ fst client) [T.null, T.any isPunctuation, T.any isSpace] ->
                WS.sendTextData connection ("Name cannot " `mappend`
                    "contain punctuation or whitespace, and " `mappend`
                    "cannot be empty" :: Text)
             | clientExists client clients ->
                WS.sendTextData connection ("User already exists" :: Text)
             | otherwise -> do
                liftIO $ modifyMVar_ state $ \s -> do
                    let s' = addClient client s
                    WS.sendTextData connection $ "Welcome! Users: " `mappend` T.intercalate ", " (map fst s)
                    broadcastBinary (bar $ BL.fromStrict $ encodeUtf8 $ fst client) s'
                    return s'
{'fraction_non_alphanumeric': 0.1050561797752809, 'fraction_numerical': 0.0044943820224719105, 'mean_word_length': 2.4325192802056557, 'pattern_counts': {'":': 0, '<': 30, '<?xml version=': 0, '>': 38, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 2, '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': '5670263', 'n_tokens_mistral': 1597, 'n_tokens_neox': 1542, 'n_words': 514}