{-# LANGUAGE RecordWildCards #-}

module Periodic.Server.GrabQueue
  ( GrabQueue
  , newGrabQueue
  , GrabItem (..)
  , pushAgent
  , popAgentSTM
  , popAgentList
  ) where

import           Control.Arrow         ((&&&))
import           Control.Monad         (unless)
import           Control.Monad.STM     (STM, retry)
import           Metro.Session         (ident)
import           Periodic.IOList       (IOList, append, delete, deleteSTM, elem,
                                        elemSTM, newIOList, toList, toListSTM)
import           Periodic.Node         (Nid)
import           Periodic.Server.Types (CSEnv)
import           Periodic.Types        (FuncName, JobHandle, Msgid)
import           Prelude               hiding (elem)
import           UnliftIO              (MonadIO (..))

data GrabItem tp = GrabItem
    { GrabItem tp -> IOList FuncName
gFuncList :: IOList FuncName
    , GrabItem tp -> CSEnv tp
gAgent    :: CSEnv tp
    , GrabItem tp -> IOList JobHandle
gJobQueue :: IOList JobHandle
    }

instance Eq (GrabItem tp) where
    == :: GrabItem tp -> GrabItem tp -> Bool
(==) = GrabItem tp -> GrabItem tp -> Bool
forall tp. GrabItem tp -> GrabItem tp -> Bool
eqGrabItem

key :: GrabItem tp -> (Nid, Msgid)
key :: GrabItem tp -> (Nid, Msgid)
key GrabItem{gAgent :: forall tp. GrabItem tp -> CSEnv tp
gAgent = CSEnv tp
a} = CSEnv tp -> (Nid, Msgid)
forall u nid k rpkt tp. SessionEnv1 u nid k rpkt tp -> (nid, k)
ident CSEnv tp
a

eqGrabItem :: GrabItem tp -> GrabItem tp -> Bool
eqGrabItem :: GrabItem tp -> GrabItem tp -> Bool
eqGrabItem a :: GrabItem tp
a b :: GrabItem tp
b = GrabItem tp -> (Nid, Msgid)
forall tp. GrabItem tp -> (Nid, Msgid)
key GrabItem tp
a (Nid, Msgid) -> (Nid, Msgid) -> Bool
forall a. Eq a => a -> a -> Bool
== GrabItem tp -> (Nid, Msgid)
forall tp. GrabItem tp -> (Nid, Msgid)
key GrabItem tp
b

type GrabQueue tp = IOList (GrabItem tp)

newGrabQueue :: MonadIO m => m (GrabQueue tp)
newGrabQueue :: m (GrabQueue tp)
newGrabQueue = m (GrabQueue tp)
forall (m :: * -> *) a. MonadIO m => m (IOList a)
newIOList

pushAgent :: MonadIO m => GrabQueue tp -> IOList FuncName -> IOList JobHandle -> CSEnv tp -> m ()
pushAgent :: GrabQueue tp
-> IOList FuncName -> IOList JobHandle -> CSEnv tp -> m ()
pushAgent q :: GrabQueue tp
q gFuncList :: IOList FuncName
gFuncList gJobQueue :: IOList JobHandle
gJobQueue gAgent :: CSEnv tp
gAgent = do
  Bool
has <- GrabQueue tp -> GrabItem tp -> m Bool
forall a (m :: * -> *).
(Eq a, MonadIO m) =>
IOList a -> a -> m Bool
elem GrabQueue tp
q GrabItem tp
i
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
has (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ GrabQueue tp -> GrabItem tp -> m ()
forall (m :: * -> *) a. MonadIO m => IOList a -> a -> m ()
append GrabQueue tp
q GrabItem tp
i
  where i :: GrabItem tp
i = GrabItem :: forall tp.
IOList FuncName -> CSEnv tp -> IOList JobHandle -> GrabItem tp
GrabItem {..}

popAgentSTM :: GrabQueue tp -> FuncName -> STM (IOList JobHandle, CSEnv tp)
popAgentSTM :: GrabQueue tp -> FuncName -> STM (IOList JobHandle, CSEnv tp)
popAgentSTM q :: GrabQueue tp
q n :: FuncName
n = do
  GrabItem tp
item <- [GrabItem tp] -> STM (GrabItem tp)
forall tp. [GrabItem tp] -> STM (GrabItem tp)
go ([GrabItem tp] -> STM (GrabItem tp))
-> STM [GrabItem tp] -> STM (GrabItem tp)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GrabQueue tp -> STM [GrabItem tp]
forall a. IOList a -> STM [a]
toListSTM GrabQueue tp
q
  GrabQueue tp -> GrabItem tp -> STM ()
forall a. Eq a => IOList a -> a -> STM ()
deleteSTM GrabQueue tp
q GrabItem tp
item
  (IOList JobHandle, CSEnv tp) -> STM (IOList JobHandle, CSEnv tp)
forall (m :: * -> *) a. Monad m => a -> m a
return (GrabItem tp -> IOList JobHandle
forall tp. GrabItem tp -> IOList JobHandle
gJobQueue GrabItem tp
item, GrabItem tp -> CSEnv tp
forall tp. GrabItem tp -> CSEnv tp
gAgent GrabItem tp
item)

 where go :: [GrabItem tp] -> STM (GrabItem tp)
       go :: [GrabItem tp] -> STM (GrabItem tp)
go [] = STM (GrabItem tp)
forall a. STM a
retry
       go (x :: GrabItem tp
x:xs :: [GrabItem tp]
xs) = do
         Bool
has <- IOList FuncName -> FuncName -> STM Bool
forall a. Eq a => IOList a -> a -> STM Bool
elemSTM (GrabItem tp -> IOList FuncName
forall tp. GrabItem tp -> IOList FuncName
gFuncList GrabItem tp
x) FuncName
n
         if Bool
has then GrabItem tp -> STM (GrabItem tp)
forall (m :: * -> *) a. Monad m => a -> m a
return GrabItem tp
x
                else [GrabItem tp] -> STM (GrabItem tp)
forall tp. [GrabItem tp] -> STM (GrabItem tp)
go [GrabItem tp]
xs

popAgentList :: MonadIO m => GrabQueue tp -> FuncName -> m [(IOList JobHandle, CSEnv tp)]
popAgentList :: GrabQueue tp -> FuncName -> m [(IOList JobHandle, CSEnv tp)]
popAgentList q :: GrabQueue tp
q n :: FuncName
n = do
  [GrabItem tp]
items <- [GrabItem tp] -> m [GrabItem tp]
forall (m :: * -> *) tp.
MonadIO m =>
[GrabItem tp] -> m [GrabItem tp]
go ([GrabItem tp] -> m [GrabItem tp])
-> m [GrabItem tp] -> m [GrabItem tp]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GrabQueue tp -> m [GrabItem tp]
forall (m :: * -> *) a. MonadIO m => IOList a -> m [a]
toList GrabQueue tp
q
  (GrabItem tp -> m ()) -> [GrabItem tp] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GrabQueue tp -> GrabItem tp -> m ()
forall a (m :: * -> *). (Eq a, MonadIO m) => IOList a -> a -> m ()
delete GrabQueue tp
q) [GrabItem tp]
items
  [(IOList JobHandle, CSEnv tp)] -> m [(IOList JobHandle, CSEnv tp)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(IOList JobHandle, CSEnv tp)]
 -> m [(IOList JobHandle, CSEnv tp)])
-> [(IOList JobHandle, CSEnv tp)]
-> m [(IOList JobHandle, CSEnv tp)]
forall a b. (a -> b) -> a -> b
$ (GrabItem tp -> (IOList JobHandle, CSEnv tp))
-> [GrabItem tp] -> [(IOList JobHandle, CSEnv tp)]
forall a b. (a -> b) -> [a] -> [b]
map (GrabItem tp -> IOList JobHandle
forall tp. GrabItem tp -> IOList JobHandle
gJobQueue (GrabItem tp -> IOList JobHandle)
-> (GrabItem tp -> CSEnv tp)
-> GrabItem tp
-> (IOList JobHandle, CSEnv tp)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& GrabItem tp -> CSEnv tp
forall tp. GrabItem tp -> CSEnv tp
gAgent) [GrabItem tp]
items

 where go :: MonadIO m => [GrabItem tp] -> m [GrabItem tp]
       go :: [GrabItem tp] -> m [GrabItem tp]
go [] = [GrabItem tp] -> m [GrabItem tp]
forall (m :: * -> *) a. Monad m => a -> m a
return []
       go (x :: GrabItem tp
x:xs :: [GrabItem tp]
xs) = do
         Bool
has <- IOList FuncName -> FuncName -> m Bool
forall a (m :: * -> *).
(Eq a, MonadIO m) =>
IOList a -> a -> m Bool
elem (GrabItem tp -> IOList FuncName
forall tp. GrabItem tp -> IOList FuncName
gFuncList GrabItem tp
x) FuncName
n
         [GrabItem tp]
xs' <- [GrabItem tp] -> m [GrabItem tp]
forall (m :: * -> *) tp.
MonadIO m =>
[GrabItem tp] -> m [GrabItem tp]
go [GrabItem tp]
xs
         if Bool
has then [GrabItem tp] -> m [GrabItem tp]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GrabItem tp
xGrabItem tp -> [GrabItem tp] -> [GrabItem tp]
forall a. a -> [a] -> [a]
:[GrabItem tp]
xs')
                else [GrabItem tp] -> m [GrabItem tp]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [GrabItem tp]
xs'