WootExamples.hs

-- stack runhaskell

{-# OPTIONS -Wall -Werror #-}

{-# LANGUAGE LambdaCase #-}

import           Control.Monad.State
import           Data.IntMap
import           Data.Woot
import           Text.Show.Pretty

type Clients = IntMap WootClient

main :: IO ()
main = pPrint . (`execState` mempty) $ do
    c1 <- newEmptyClient
    modify $ adjust (appendString "привет людишки") c1
    c2 <- cloneClient c1
    c3 <- cloneClient c1
    modify $ adjust (appendString "пиплы" . deleteChars 7 7) c2
    modify $ adjust (appendString "народ" . deleteChars 7 7) c3

appendString :: String -> WootClient -> WootClient
appendString string client =
    insertString (length . show $ wootClientString client) string client

insertString :: Int -> String -> WootClient -> WootClient
insertString pos string =
    case string of
        ""        -> id
        char:rest -> insertString (succ pos) rest . insertChar pos char

insertChar :: Int -> Char -> WootClient -> WootClient
insertChar pos char client = let
    (Just _, res) = sendLocalInsert client pos char
    in
    res

newEmptyClient :: State Clients Int
newEmptyClient = do
    clientId <- gets length
    modify $ insert clientId $ makeWootClientEmpty clientId
    pure clientId

cloneClient :: Int -> State Clients Int
cloneClient existingClientId = do
    existingClient <- gets (! existingClientId)
    newClientId <- gets length
    modify $ insert newClientId $ existingClient{wootClientId = newClientId}
    pure newClientId

deleteChars :: Int -> Int -> WootClient -> WootClient
deleteChars pos count = case count of
    0 -> id
    _ -> deleteChars pos (pred count) . deleteChar pos

deleteChar :: Int -> WootClient -> WootClient
deleteChar pos client = let
    (Just _, res) = sendLocalDelete client pos
    in
    res