zre-0.1.0.0: app/Cat.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Monad
import Control.Monad.IO.Class
import Control.Concurrent
import Control.Concurrent.Async.Lifted

import qualified Data.ByteString.Char8 as B

import System.IO
import System.Environment

import Network.ZRE

main :: IO ()
main = do
  args <- getArgs
  let group = B.pack $ head args :: B.ByteString

  -- XXX: FIXME: doesn't uses global option parser,
  -- we should probably have 'zre cat' and only keep this in examples
  -- not as an app
  runZre' defaultConf $ groupCat group

groupCat :: Group -> ZRE ()
groupCat group = do
  zjoin group
  -- wait a sec so join is received by peers before sending stuff
  void $ async $ (liftIO $ threadDelay 1000000) >> (stdin' group)
  cat

catln :: ZRE ()
catln = forever $ do
  e <- readZ
  case e of
    Shout _uuid _group content _time  -> liftIO $ B.putStrLn $ B.concat content
    Whisper _uuid content _time -> liftIO $ B.putStrLn $ B.concat content
    _ -> return ()

cat :: ZRE ()
cat = forever $ do
  e <- readZ
  case e of
    Shout _uuid _group content _time  -> liftIO $ B.putStr $ B.concat content
    Whisper _uuid content _time -> liftIO $ B.putStr $ B.concat content
    _ -> return ()

stdinln :: Group -> ZRE ()
stdinln group = forever $ do
  l <- fmap B.pack $ liftIO getLine
  zshout group l

bufsize :: Int
bufsize = 1024*128

stdin' :: Group -> ZRE ()
stdin' group = do
  liftIO $ hSetBuffering stdin $ BlockBuffering (Just bufsize)
  forever $ do
    eof <- liftIO $ hIsEOF stdin
    case eof of
      True -> zquit
      False -> do
        buf <- liftIO $ B.hGetSome stdin bufsize
        zshout group buf