{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

module Metro.Class
  ( Transport (..)
  , TransportError (..)
  , Servable (..)
  , RecvPacket (..)
  , SendPacket (..)
  , sendBinary
  , SetPacketId (..)
  , GetPacketId (..)
  ) where

import           Control.Exception    (Exception)
import           Data.Binary          (Binary, encode)
import           Data.ByteString      (ByteString)
import           Data.ByteString.Lazy (toStrict)
import           UnliftIO             (MonadIO, MonadUnliftIO)

data TransportError = TransportClosed
    deriving (Int -> TransportError -> ShowS
[TransportError] -> ShowS
TransportError -> String
(Int -> TransportError -> ShowS)
-> (TransportError -> String)
-> ([TransportError] -> ShowS)
-> Show TransportError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransportError] -> ShowS
$cshowList :: [TransportError] -> ShowS
show :: TransportError -> String
$cshow :: TransportError -> String
showsPrec :: Int -> TransportError -> ShowS
$cshowsPrec :: Int -> TransportError -> ShowS
Show, TransportError -> TransportError -> Bool
(TransportError -> TransportError -> Bool)
-> (TransportError -> TransportError -> Bool) -> Eq TransportError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransportError -> TransportError -> Bool
$c/= :: TransportError -> TransportError -> Bool
== :: TransportError -> TransportError -> Bool
$c== :: TransportError -> TransportError -> Bool
Eq, Eq TransportError
Eq TransportError
-> (TransportError -> TransportError -> Ordering)
-> (TransportError -> TransportError -> Bool)
-> (TransportError -> TransportError -> Bool)
-> (TransportError -> TransportError -> Bool)
-> (TransportError -> TransportError -> Bool)
-> (TransportError -> TransportError -> TransportError)
-> (TransportError -> TransportError -> TransportError)
-> Ord TransportError
TransportError -> TransportError -> Bool
TransportError -> TransportError -> Ordering
TransportError -> TransportError -> TransportError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TransportError -> TransportError -> TransportError
$cmin :: TransportError -> TransportError -> TransportError
max :: TransportError -> TransportError -> TransportError
$cmax :: TransportError -> TransportError -> TransportError
>= :: TransportError -> TransportError -> Bool
$c>= :: TransportError -> TransportError -> Bool
> :: TransportError -> TransportError -> Bool
$c> :: TransportError -> TransportError -> Bool
<= :: TransportError -> TransportError -> Bool
$c<= :: TransportError -> TransportError -> Bool
< :: TransportError -> TransportError -> Bool
$c< :: TransportError -> TransportError -> Bool
compare :: TransportError -> TransportError -> Ordering
$ccompare :: TransportError -> TransportError -> Ordering
$cp1Ord :: Eq TransportError
Ord)

instance Exception TransportError

class Transport transport where
  data TransportConfig transport
  newTransport   :: TransportConfig transport -> IO transport
  recvData       :: transport -> Int -> IO ByteString
  sendData       :: transport -> ByteString -> IO ()
  closeTransport :: transport -> IO ()

class Servable serv where
  data ServerConfig serv
  type SID serv
  type STP serv
  newServer   :: MonadIO m => ServerConfig serv -> m serv
  servOnce    :: MonadUnliftIO m => serv -> (Maybe (SID serv, TransportConfig (STP serv)) -> m ()) -> m ()
  onConnEnter :: MonadIO m => serv -> SID serv -> m ()
  onConnLeave :: MonadIO m => serv -> SID serv -> m ()
  servClose   :: MonadIO m => serv -> m ()

class RecvPacket rpkt where
  recvPacket :: MonadIO m => (Int -> m ByteString) -> m rpkt

class SendPacket spkt where
  sendPacket :: MonadIO m => spkt -> (ByteString -> m ()) -> m ()
  default sendPacket :: (MonadIO m, Binary spkt) => spkt -> (ByteString -> m ()) -> m ()
  sendPacket = spkt -> (ByteString -> m ()) -> m ()
forall (m :: * -> *) spkt.
(MonadIO m, Binary spkt) =>
spkt -> (ByteString -> m ()) -> m ()
sendBinary

sendBinary :: (MonadIO m, Binary spkt) => spkt -> (ByteString -> m ()) -> m ()
sendBinary :: spkt -> (ByteString -> m ()) -> m ()
sendBinary spkt
spkt ByteString -> m ()
send = ByteString -> m ()
send (ByteString -> m ())
-> (ByteString -> ByteString) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ spkt -> ByteString
forall a. Binary a => a -> ByteString
encode spkt
spkt

class SetPacketId k pkt where
  setPacketId :: k -> pkt -> pkt

class GetPacketId k pkt where
  getPacketId :: pkt -> k