module Network.ZRE.Lib where

import Control.Applicative
import Control.Monad

import Data.Either
import qualified Data.ByteString.Char8 as B

import Data.ZRE (Group)
import Network.ZRE.Types

zrecvWithShout:: (B.ByteString -> ZRE ()) -> ZRE ()
zrecvWithShout :: (ByteString -> ZRE ()) -> ZRE ()
zrecvWithShout f :: ByteString -> ZRE ()
f = do
  Event
e <- ZRE Event
zrecv
  case Event
e of
    Shout _ _ content :: Content
content _time :: UTCTime
_time -> ByteString -> ZRE ()
f (Content -> ByteString
B.concat Content
content)
    _ -> () -> ZRE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

zrecvShouts :: (B.ByteString -> ZRE ()) -> ZRE b
zrecvShouts :: (ByteString -> ZRE ()) -> ZRE b
zrecvShouts fn :: ByteString -> ZRE ()
fn = ZRE () -> ZRE b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ZRE () -> ZRE b) -> ZRE () -> ZRE b
forall a b. (a -> b) -> a -> b
$ (ByteString -> ZRE ()) -> ZRE ()
zrecvWithShout ByteString -> ZRE ()
fn

whenDecodes :: Monad m
            => (msg -> Either a decoded)
            -> (decoded -> m ())
            -> msg
            -> m ()
whenDecodes :: (msg -> Either a decoded) -> (decoded -> m ()) -> msg -> m ()
whenDecodes decoder :: msg -> Either a decoded
decoder action :: decoded -> m ()
action content :: msg
content = case msg -> Either a decoded
decoder msg
content of
  Left _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Right x :: decoded
x -> decoded -> m ()
action decoded
x

decodeShouts :: (Monad m, Alternative m)
             => (Event -> Either a decoded)
             -> (decoded -> ZRE ())
             -> Event
             -> m (ZRE ())
decodeShouts :: (Event -> Either a decoded)
-> (decoded -> ZRE ()) -> Event -> m (ZRE ())
decodeShouts fn :: Event -> Either a decoded
fn action :: decoded -> ZRE ()
action msg :: Event
msg = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Event -> Bool
isShout Event
msg
  let res :: Either a decoded
res = Event -> Either a decoded
fn Event
msg
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Either a decoded -> Bool
forall a b. Either a b -> Bool
isRight Either a decoded
res
  case Either a decoded
res of
    Left _ -> ZRE () -> m (ZRE ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ZRE () -> m (ZRE ())) -> ZRE () -> m (ZRE ())
forall a b. (a -> b) -> a -> b
$ () -> ZRE ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right x :: decoded
x -> ZRE () -> m (ZRE ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ZRE () -> m (ZRE ())) -> ZRE () -> m (ZRE ())
forall a b. (a -> b) -> a -> b
$ ZRE Event
readZ ZRE Event -> ZRE () -> ZRE ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> decoded -> ZRE ()
action decoded
x

isShout :: Event -> Bool
isShout :: Event -> Bool
isShout (Shout _uuid :: UUID
_uuid _group :: ByteString
_group _content :: Content
_content _time :: UTCTime
_time) = Bool
True
isShout _ = Bool
False

isGroupMsg :: Group -> Event -> Bool
isGroupMsg :: ByteString -> Event -> Bool
isGroupMsg group :: ByteString
group (Shout _uuid :: UUID
_uuid g :: ByteString
g _content :: Content
_content _time :: UTCTime
_time) = ByteString
g ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
group
isGroupMsg _ _ = Bool
False

(==>) :: (Monad m, Alternative m) => (t -> Bool) -> b -> t -> m b
==> :: (t -> Bool) -> b -> t -> m b
(==>) f :: t -> Bool
f act :: b
act = (t -> Bool) -> b -> t -> m b
forall (m :: * -> *) t b.
(Monad m, Alternative m) =>
(t -> Bool) -> b -> t -> m b
iff t -> Bool
f b
act

iff :: (Monad m, Alternative m) => (t -> Bool) -> b -> t -> m b
iff :: (t -> Bool) -> b -> t -> m b
iff f :: t -> Bool
f act :: b
act msg :: t
msg = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ t -> Bool
f t
msg
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ b
act

match :: [Event -> Maybe (ZRE ())] -> ZRE ()
match :: [Event -> Maybe (ZRE ())] -> ZRE ()
match acts :: [Event -> Maybe (ZRE ())]
acts = do
  Event
msg <- ZRE Event
readZ
  [Event -> Maybe (ZRE ())] -> Event -> ZRE ()
go [Event -> Maybe (ZRE ())]
acts Event
msg
  where
    go :: [Event -> Maybe (ZRE ())] -> Event -> ZRE ()
go (act :: Event -> Maybe (ZRE ())
act:rest :: [Event -> Maybe (ZRE ())]
rest) m :: Event
m = do
      case Event -> Maybe (ZRE ())
act Event
m of
        Nothing -> [Event -> Maybe (ZRE ())] -> Event -> ZRE ()
go [Event -> Maybe (ZRE ())]
rest Event
m
        Just a :: ZRE ()
a -> Event -> ZRE ()
unReadZ Event
m ZRE () -> ZRE () -> ZRE ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ZRE ()
a

    go [] _ = () -> ZRE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()