{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE DerivingStrategies #-}

module MatrixBot.Bot.Jobs.Queue
  ( BotJobsQueue (..)
  , mkBotJobsQueue
  , HasBotJobsReader (..)
  , HasBotJobsWriter (..)
  ) where

import qualified UnliftIO.STM as STM
import Control.Monad.IO.Class (MonadIO)
import MatrixBot.Bot.Jobs.BotJob (BotJob)
import Data.Functor ((<&>))
import qualified Control.Lens.Getter as Lens


-- | A queue of Bot Jobs interface
data BotJobsQueue = BotJobsQueue
  { BotJobsQueue -> BotJob -> STM ()
sendJob ∷ BotJob → STM.STM ()
  , BotJobsQueue -> STM BotJob
getNextJob ∷ STM.STM BotJob
  -- ^ Blocking operation (will wait for another job to appear)
  }


mkBotJobsQueue ∷ MonadIO m ⇒ m BotJobsQueue
mkBotJobsQueue :: forall (m :: * -> *). MonadIO m => m BotJobsQueue
mkBotJobsQueue =
  m (TQueue BotJob)
forall (m :: * -> *) a. MonadIO m => m (TQueue a)
STM.newTQueueIO m (TQueue BotJob)
-> (TQueue BotJob -> BotJobsQueue) -> m BotJobsQueue
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \TQueue BotJob
jobsQueue ->
    BotJobsQueue
      { sendJob :: BotJob -> STM ()
sendJob = TQueue BotJob -> BotJob -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue BotJob
jobsQueue
      , getNextJob :: STM BotJob
getNextJob = TQueue BotJob -> STM BotJob
forall a. TQueue a -> STM a
STM.readTQueue TQueue BotJob
jobsQueue
      }


class HasBotJobsReader r where
  botJobsReader ∷ Lens.Getter r (STM.STM BotJob)

instance HasBotJobsReader BotJobsQueue where
  botJobsReader :: Getter BotJobsQueue (STM BotJob)
botJobsReader = (BotJobsQueue -> STM BotJob)
-> (STM BotJob -> f (STM BotJob)) -> BotJobsQueue -> f BotJobsQueue
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to BotJobsQueue -> STM BotJob
getNextJob


class HasBotJobsWriter r where
  botJobsWriter ∷ Lens.Getter r (BotJob → STM.STM ())

instance HasBotJobsWriter BotJobsQueue where
  botJobsWriter :: Getter BotJobsQueue (BotJob -> STM ())
botJobsWriter = (BotJobsQueue -> BotJob -> STM ())
-> ((BotJob -> STM ()) -> f (BotJob -> STM ()))
-> BotJobsQueue
-> f BotJobsQueue
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to BotJobsQueue -> BotJob -> STM ()
sendJob