{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Trustworthy #-}
module Network.Tox.Network.Networked where
import Control.Applicative (Applicative, (<$>))
import Control.Monad.Random (RandT)
import Control.Monad.Reader (ReaderT)
import Control.Monad.State (MonadState, StateT)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Writer (WriterT, execWriterT,
runWriterT, tell)
import Data.Binary (Binary)
import Data.Monoid (Monoid)
import Network.Tox.Network.MonadRandomBytes (MonadRandomBytes)
import Network.Tox.NodeInfo.NodeInfo (NodeInfo)
import Network.Tox.Protocol.Packet (Packet (..))
import Network.Tox.Timed (Timed)
class Monad m => Networked m where
sendPacket :: (Binary payload, Show payload) => NodeInfo -> Packet payload -> m ()
instance Networked (StateT NetworkState IO) where
sendPacket _ _ = return ()
type NetworkState = ()
type NetworkEvent = String
newtype NetworkLogged m a = NetworkLogged (WriterT [NetworkEvent] m a)
deriving (Monad, Applicative, Functor, MonadState s, MonadRandomBytes, Timed)
runNetworkLogged :: Monad m => NetworkLogged m a -> m (a, [NetworkEvent])
runNetworkLogged (NetworkLogged m) = runWriterT m
evalNetworkLogged :: (Monad m, Applicative m) => NetworkLogged m a -> m a
evalNetworkLogged = (fst <$>) . runNetworkLogged
execNetworkLogged :: Monad m => NetworkLogged m a -> m [NetworkEvent]
execNetworkLogged (NetworkLogged m) = execWriterT m
instance Monad m => Networked (NetworkLogged m) where
sendPacket to packet = NetworkLogged $
tell [">>> " ++ show to ++ " : " ++ show packet]
instance Networked m => Networked (ReaderT r m) where
sendPacket = (lift .) . sendPacket
instance (Monoid w, Networked m) => Networked (WriterT w m) where
sendPacket = (lift .) . sendPacket
instance Networked m => Networked (RandT s m) where
sendPacket = (lift .) . sendPacket
instance Networked m => Networked (StateT s m) where
sendPacket = (lift .) . sendPacket