server :: StateT SIO.RoutingTable (ReaderT SIO.Socket Handler) ()
server = do
  OTDemo {..} <- YC.getYesod
  s <- ask
  let sid = T.pack . BSC8.unpack $ SIO.socketId s
  runLogging <- flip ML.runLoggingT <$> ML.askLoggerIO
  $(YC.logDebug) $ "New client joined: " <> sid

  mayEditTV <- liftIO $ STM.newTVarIO False
  let mayEdit = liftIO $ STM.readTVarIO mayEditTV

  SIO.on "login" $ \(UserLogin name) -> do
    let client = ClientState name mempty
    liftIO $ STM.atomically $ do
      STM.writeTVar mayEditTV True
      STM.modifyTVar clients (M.insert sid client)
    runLogging $ $(YC.logDebug) $ "Client logged in: " <> sid <> " is now '" <> name <> "'"
    SIO.broadcastJSON "set_name" [toJSON sid, toJSON name]
    SIO.emitJSON "logged_in" []

  SIO.on "operation" $ \rev op (sel :: Sel.Selection) -> do
    me <- mayEdit
    unless me $ fail "user is not allowed to make any changes"
    runLogging $ $(YC.logDebug) $ "New operation from client " <> sid
    res <- liftIO $ STM.atomically $ do
     ss <- STM.readTVar serverState
     case OTS.applyOperation ss rev op sel of
       Left err -> return (Left err)
       Right (op', sel', ss') -> do
         STM.writeTVar serverState ss'
         return $ Right (op', sel')
    case res of
      Left err -> liftIO $ putStrLn err
      Right (op', sel') -> do
        liftIO $ putStrLn $ "new operation: " ++ show op'
        SIO.emitJSON "ack" []
        SIO.broadcastJSON "operation" [toJSON sid, toJSON op', toJSON sel']

  SIO.on "selection" $ \sel -> do
    me <- mayEdit
    unless me $ fail "user is not allowed to select anything"
    liftIO $ STM.atomically $
      STM.modifyTVar clients (M.adjust (\u -> u { clientSelection = sel }) sid)
    SIO.broadcastJSON "selection" [toJSON sid, toJSON sel]

  SIO.appendDisconnectHandler $ do
    runLogging $ $(YC.logDebug) $ "Client disconnected: " <> sid
    liftIO $ STM.atomically $ STM.modifyTVar clients (M.delete sid)
    SIO.broadcast "client_left" sid

  -- send initial message
  currClients <- liftIO $ STM.readTVarIO clients
  OTS.ServerState rev doc _ <- liftIO $ STM.readTVarIO serverState
  SIO.emit "doc" $ object
    [ "str" .= doc
    , "revision" .= rev
    , "clients" .= currClients
    ]
server :: StateT SIO.RoutingTable (ReaderT SIO.Socket Handler) ()
server = do
  OTDemo {..} <- YC.getYesod
  s <- ask
  let sid = T.pack . BSC8.unpack $ SIO.socketId s
  runLogging <- flip ML.runLoggingT <$> ML.askLoggerIO
  $(YC.logDebug) $ "New client joined: " <> sid

  mayEditTV <- liftIO $ STM.newTVarIO False
  let mayEdit = liftIO $ STM.readTVarIO mayEditTV

  SIO.on "login" $ \(UserLogin name) -> do
    let client = ClientState name mempty
    liftIO $ STM.atomically $ do
      STM.writeTVar mayEditTV True
      STM.modifyTVar clients (M.insert sid client)
    runLogging $ $(YC.logDebug) $ "Client logged in: " <> sid <> " is now '" <> name <> "'"
    SIO.broadcastJSON "set_name" [toJSON sid, toJSON name]
    SIO.emitJSON "logged_in" []

  SIO.on "operation" $ \rev op (sel :: Sel.Selection) -> do
    me <- mayEdit
    unless me $ fail "user is not allowed to make any changes"
    runLogging $ $(YC.logDebug) $ "New operation from client " <> sid
    res <- liftIO $ STM.atomically $ do
     ss <- STM.readTVar serverState
     case OTS.applyOperation ss rev op sel of
       Left err -> return (Left err)
       Right (op', sel', ss') -> do
         STM.writeTVar serverState ss'
         return $ Right (op', sel')
    case res of
      Left err -> liftIO $ putStrLn err
      Right (op', sel') -> do
        liftIO $ putStrLn $ "new operation: " ++ show op'
        SIO.emitJSON "ack" []
        SIO.broadcastJSON "operation" [toJSON sid, toJSON op', toJSON sel']

  SIO.on "selection" $ \sel -> do
    me <- mayEdit
    unless me $ fail "user is not allowed to select anything"
    liftIO $ STM.atomically $
      STM.modifyTVar clients (M.adjust (\u -> u { clientSelection = sel }) sid)
    SIO.broadcastJSON "selection" [toJSON sid, toJSON sel]

  SIO.appendDisconnectHandler $ do
    runLogging $ $(YC.logDebug) $ "Client disconnected: " <> sid
    liftIO $ STM.atomically $ STM.modifyTVar clients (M.delete sid)
    SIO.broadcast "client_left" sid

  -- send initial message
  currClients <- liftIO $ STM.readTVarIO clients
  OTS.ServerState rev doc _ <- liftIO $ STM.readTVarIO serverState
  SIO.emit "doc" $ object
    [ "str" .= doc
    , "revision" .= rev
    , "clients" .= currClients
    ]
server = do
  OTDemo {..} <- YC.getYesod
  s <- ask
  let sid = T.pack . BSC8.unpack $ SIO.socketId s
  runLogging <- flip ML.runLoggingT <$> ML.askLoggerIO
  $(YC.logDebug) $ "New client joined: " <> sid

  mayEditTV <- liftIO $ STM.newTVarIO False
  let mayEdit = liftIO $ STM.readTVarIO mayEditTV

  SIO.on "login" $ \(UserLogin name) -> do
    let client = ClientState name mempty
    liftIO $ STM.atomically $ do
      STM.writeTVar mayEditTV True
      STM.modifyTVar clients (M.insert sid client)
    runLogging $ $(YC.logDebug) $ "Client logged in: " <> sid <> " is now '" <> name <> "'"
    SIO.broadcastJSON "set_name" [toJSON sid, toJSON name]
    SIO.emitJSON "logged_in" []

  SIO.on "operation" $ \rev op (sel :: Sel.Selection) -> do
    me <- mayEdit
    unless me $ fail "user is not allowed to make any changes"
    runLogging $ $(YC.logDebug) $ "New operation from client " <> sid
    res <- liftIO $ STM.atomically $ do
     ss <- STM.readTVar serverState
     case OTS.applyOperation ss rev op sel of
       Left err -> return (Left err)
       Right (op', sel', ss') -> do
         STM.writeTVar serverState ss'
         return $ Right (op', sel')
    case res of
      Left err -> liftIO $ putStrLn err
      Right (op', sel') -> do
        liftIO $ putStrLn $ "new operation: " ++ show op'
        SIO.emitJSON "ack" []
        SIO.broadcastJSON "operation" [toJSON sid, toJSON op', toJSON sel']

  SIO.on "selection" $ \sel -> do
    me <- mayEdit
    unless me $ fail "user is not allowed to select anything"
    liftIO $ STM.atomically $
      STM.modifyTVar clients (M.adjust (\u -> u { clientSelection = sel }) sid)
    SIO.broadcastJSON "selection" [toJSON sid, toJSON sel]

  SIO.appendDisconnectHandler $ do
    runLogging $ $(YC.logDebug) $ "Client disconnected: " <> sid
    liftIO $ STM.atomically $ STM.modifyTVar clients (M.delete sid)
    SIO.broadcast "client_left" sid

  -- send initial message
  currClients <- liftIO $ STM.readTVarIO clients
  OTS.ServerState rev doc _ <- liftIO $ STM.readTVarIO serverState
  SIO.emit "doc" $ object
    [ "str" .= doc
    , "revision" .= rev
    , "clients" .= currClients
    ]