zyre2-0.1.1.0: app/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent (forkIO, threadDelay)
import Control.Monad (forM_, join, void)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Text as T (Text, pack, unpack)
import qualified Network.Zyre2 as Zyre
import System.Environment (getArgs)

-- | Main function that handles example selection.
main :: IO ()
main = do
  args <- getArgs
  case args of
    ("minimal" : x : _) -> minimal (T.pack x)
    ("chat" : x : _) -> chat (T.pack x)
    _ -> error "Unknown example."

-- | Zyre chat example adapted from examples/minimal/minimal.c
minimal :: Text -> IO ()
minimal name = do
  let room = "ROOM"

  ctx <- Zyre.new (Just name)
  ctx <- Zyre.start ctx
  Zyre.join ctx room

  forM_ [0 .. 10] $ \_ -> do
    Zyre.shouts ctx room ("Hello from " <> name)

    threadDelay $ 1000 * 250
    mMsg <- Zyre.recv ctx
    print mMsg
    case mMsg of
      Just Zyre.Shout {} -> print (fst . Zyre.popText =<< mMsg)
      _ -> pure ()

  Zyre.leave ctx room

  ctx <- Zyre.stop ctx
  void . Zyre.destroy $ ctx

-- | Zyre chat example adapted from examples/chat/chat.c
chat :: Text -> IO ()
chat name = do
  let room = "CHAT"

  terminateRef <- newIORef False

  ctx <- Zyre.new (Just name)
  ctx <- Zyre.start ctx
  Zyre.join ctx room

  -- Fork a thread to receive messages and output them to stdout.
  void . forkIO $
    whileM_ (readIORef terminateRef) $ do
      mMsg <- Zyre.recv ctx
      case mMsg of
        Just zmsg@Zyre.Shout {} -> do
          putStr $ T.unpack $ Zyre._zmsgName zmsg <> ": "
          case Zyre.popText zmsg of
            (Just m, _) -> putStrLn $ T.unpack m
            _ -> putStrLn "Message could not be decoded or was empty"
        Just zmsg@Zyre.Join {} -> putStrLn $ T.unpack $ Zyre._zmsgName zmsg <> " has joined the chat"
        Just zmsg@Zyre.Leave {} -> putStrLn $ T.unpack $ Zyre._zmsgName zmsg <> " has left the chat"
        Just zmsg@Zyre.Evasive {} -> putStrLn $ T.unpack $ Zyre._zmsgName zmsg <> " is being evasive"
        Just zmsg@Zyre.Silent {} -> putStrLn $ T.unpack $ Zyre._zmsgName zmsg <> " is being silent"
        _ -> pure ()

  whileM_ (readIORef terminateRef) $ do
    line <- fmap T.pack getLine
    case line of
      "$TERM" -> do
        writeIORef terminateRef True
        Zyre.leave ctx room
        ctx <- Zyre.stop ctx
        void $ Zyre.destroy ctx
      _ -> void $ Zyre.shouts ctx room line

-- | Loop over an action until monadic condition is fulfilled to stop.
whileM_ :: (Monad m) => m Bool -> m () -> m ()
whileM_ condition fn = do
  stop <- condition
  if not stop
    then do
      fn
      whileM_ condition fn
    else pure ()