-- | Contains stuff for managing shards
module Calamity.Client.ShardManager
    ( shardBot ) where

import           Calamity.Client.Types
import           Calamity.Gateway
import           Calamity.HTTP
import           Calamity.Internal.Utils

import           Control.Concurrent.MVar
import           Control.Concurrent.STM
import           Control.Lens
import           Control.Monad

import           Data.Traversable

import           Fmt

import           Polysemy                    ( Sem )
import qualified Polysemy.Fail               as P
import qualified Polysemy                    as P
import qualified Polysemy.Reader             as P

-- | Connects the bot to the gateway over n shards
shardBot :: (BotC r, P.Member P.Fail r) => Sem r ()
shardBot :: Sem r ()
shardBot = do
  MVar Int
numShardsVar <- (Client -> MVar Int) -> Sem r (MVar Int)
forall i j (r :: [(* -> *) -> * -> *]).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> MVar Int
numShards
  TVar [(Shard, Async (Maybe ()))]
shardsVar <- (Client -> TVar [(Shard, Async (Maybe ()))])
-> Sem r (TVar [(Shard, Async (Maybe ()))])
forall i j (r :: [(* -> *) -> * -> *]).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> TVar [(Shard, Async (Maybe ()))]
shards

  Bool
hasShards <- IO Bool -> Sem r Bool
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO Bool -> Sem r Bool) -> IO Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool)
-> ([(Shard, Async (Maybe ()))] -> Bool)
-> [(Shard, Async (Maybe ()))]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Shard, Async (Maybe ()))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Shard, Async (Maybe ()))] -> Bool)
-> IO [(Shard, Async (Maybe ()))] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar [(Shard, Async (Maybe ()))] -> IO [(Shard, Async (Maybe ()))]
forall a. TVar a -> IO a
readTVarIO TVar [(Shard, Async (Maybe ()))]
shardsVar
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasShards (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String -> Sem r ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "don't use shardBot on an already running bot."

  Token
token <- (Client -> Token) -> Sem r Token
forall i j (r :: [(* -> *) -> * -> *]).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> Token
Calamity.Client.Types.token
  TQueue DispatchMessage
eventQueue <- (Client -> TQueue DispatchMessage)
-> Sem r (TQueue DispatchMessage)
forall i j (r :: [(* -> *) -> * -> *]).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> TQueue DispatchMessage
eventQueue

  Right gateway :: BotGatewayResponse
gateway <- MiscRequest BotGatewayResponse
-> Sem r (Either RestError BotGatewayResponse)
forall a r (reffs :: [(* -> *) -> * -> *]).
(Request a r, BotC reffs, FromJSON r) =>
a -> Sem reffs (Either RestError r)
invokeRequest MiscRequest BotGatewayResponse
GetGatewayBot

  let numShards' :: Int
numShards' = BotGatewayResponse
gateway BotGatewayResponse -> Getting Int BotGatewayResponse Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "shards" (Getting Int BotGatewayResponse Int)
Getting Int BotGatewayResponse Int
#shards
  let host :: Text
host = BotGatewayResponse
gateway BotGatewayResponse -> Getting Text BotGatewayResponse Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "url" (Getting Text BotGatewayResponse Text)
Getting Text BotGatewayResponse Text
#url
  IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
numShardsVar Int
numShards'

  Text -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Member LogEff r =>
Text -> Sem r ()
info (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ "Number of shards: " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
numShards' Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""

  [(Shard, Async (Maybe ()))]
shards <- [Int]
-> (Int -> Sem r (Shard, Async (Maybe ())))
-> Sem r [(Shard, Async (Maybe ()))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [0 .. Int
numShards' Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1] ((Int -> Sem r (Shard, Async (Maybe ())))
 -> Sem r [(Shard, Async (Maybe ()))])
-> (Int -> Sem r (Shard, Async (Maybe ())))
-> Sem r [(Shard, Async (Maybe ()))]
forall a b. (a -> b) -> a -> b
$ \id :: Int
id ->
    Text
-> Int
-> Int
-> Token
-> TQueue DispatchMessage
-> Sem r (Shard, Async (Maybe ()))
forall (r :: [(* -> *) -> * -> *]).
Members '[LogEff, MetricEff, Embed IO, Final IO, Async] r =>
Text
-> Int
-> Int
-> Token
-> TQueue DispatchMessage
-> Sem r (Shard, Async (Maybe ()))
newShard Text
host Int
id Int
numShards' Token
token TQueue DispatchMessage
eventQueue

  IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO () -> Sem r ()) -> (STM () -> IO ()) -> STM () -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> Sem r ()) -> STM () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TVar [(Shard, Async (Maybe ()))]
-> [(Shard, Async (Maybe ()))] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [(Shard, Async (Maybe ()))]
shardsVar [(Shard, Async (Maybe ()))]
shards

-- | Connects the bot to the gateway over 1 shard (userbot)
-- shardUserBot :: BotM ()
-- shardUserBot = do
--   numShardsVar <- asks numShards
--   shardsVar <- asks shards

--   hasShards <- liftIO $ (not . null) <$> readTVarIO shardsVar
--   when hasShards $ fail "don't use shardUserBot on an already running bot."

--   token <- asks Calamity.Client.Types.token
--   eventQueue <- asks eventQueue
--   logEnv <- askLog

--   gateway <- aa <$> invokeRequest GetGateway

--   let host = gateway ^. #url
--   liftIO $ putMVar numShardsVar 1

--   liftIO $ do
--     shard <- newShard host 0 1 token logEnv eventQueue
--     atomically $ writeTVar shardsVar [shard]