{-# LANGUAGE TypeApplications #-}

module Entries
  ( Entries,
    empty,
    Entries.null,
    size,
    insert,
    delete,
    partition,
  )
where

import Data.Coerce
import Data.IntPSQ (IntPSQ)
import qualified Data.IntPSQ as IntPSQ
import Data.Word (Word64)

newtype Entries
  = Entries (IntPSQ Word64 (IO ()))

-- | An empty collection.
empty :: Entries
empty :: Entries
empty =
  IntPSQ Word64 (IO ()) -> Entries
Entries IntPSQ Word64 (IO ())
forall p v. IntPSQ p v
IntPSQ.empty
{-# INLINEABLE empty #-}

null :: Entries -> Bool
null :: Entries -> Bool
null =
  (IntPSQ Word64 (IO ()) -> Bool) -> Entries -> Bool
coerce (IntPSQ Word64 (IO ()) -> Bool
forall p v. IntPSQ p v -> Bool
IntPSQ.null @Word64 @(IO ()))
{-# INLINEABLE null #-}

-- | The number of timers in the collection.
size :: Entries -> Int
size :: Entries -> Int
size =
  (IntPSQ Word64 (IO ()) -> Int) -> Entries -> Int
coerce (IntPSQ Word64 (IO ()) -> Int
forall p v. IntPSQ p v -> Int
IntPSQ.size @Word64 @(IO ()))
{-# INLINEABLE size #-}

-- | @insert i n m x@ inserts callback @m@ into collection @x@ with unique
-- identifier @i@ and "count" @n@. The
insert :: Int -> Word64 -> IO () -> Entries -> Entries
insert :: Int -> Word64 -> IO () -> Entries -> Entries
insert Int
i Word64
n IO ()
m =
  (IntPSQ Word64 (IO ()) -> IntPSQ Word64 (IO ()))
-> Entries -> Entries
coerce (Int
-> Word64
-> IO ()
-> IntPSQ Word64 (IO ())
-> IntPSQ Word64 (IO ())
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.unsafeInsertNew Int
i Word64
n IO ()
m)
{-# INLINEABLE insert #-}

-- | Delete a timer by id. Returns 'Nothing' if the timer was not found.
delete :: Int -> Entries -> Maybe Entries
delete :: Int -> Entries -> Maybe Entries
delete =
  (Int -> IntPSQ Word64 (IO ()) -> Maybe (IntPSQ Word64 (IO ())))
-> Int -> Entries -> Maybe Entries
coerce Int -> IntPSQ Word64 (IO ()) -> Maybe (IntPSQ Word64 (IO ()))
delete_
{-# INLINEABLE delete #-}

delete_ :: Int -> IntPSQ Word64 (IO ()) -> Maybe (IntPSQ Word64 (IO ()))
delete_ :: Int -> IntPSQ Word64 (IO ()) -> Maybe (IntPSQ Word64 (IO ()))
delete_ Int
i IntPSQ Word64 (IO ())
xs =
  (\(Word64
_, IO ()
_, IntPSQ Word64 (IO ())
ys) -> IntPSQ Word64 (IO ())
ys) ((Word64, IO (), IntPSQ Word64 (IO ())) -> IntPSQ Word64 (IO ()))
-> Maybe (Word64, IO (), IntPSQ Word64 (IO ()))
-> Maybe (IntPSQ Word64 (IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> IntPSQ Word64 (IO ())
-> Maybe (Word64, IO (), IntPSQ Word64 (IO ()))
forall p v. Ord p => Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
IntPSQ.deleteView Int
i IntPSQ Word64 (IO ())
xs

-- | Extract expired timers.
partition :: Entries -> ([IO ()], Entries)
partition :: Entries -> ([IO ()], Entries)
partition (Entries IntPSQ Word64 (IO ())
entries) =
  case Word64
-> IntPSQ Word64 (IO ())
-> ([(Int, Word64, IO ())], IntPSQ Word64 (IO ()))
forall p v. Ord p => p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
IntPSQ.atMostView Word64
0 IntPSQ Word64 (IO ())
entries of
    ([(Int, Word64, IO ())]
expired, IntPSQ Word64 (IO ())
alive) ->
      (((Int, Word64, IO ()) -> IO ())
-> [(Int, Word64, IO ())] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Word64, IO ()) -> IO ()
f [(Int, Word64, IO ())]
expired, IntPSQ Word64 (IO ()) -> Entries
Entries ((Int -> Word64 -> IO () -> (Word64, IO ()))
-> IntPSQ Word64 (IO ()) -> IntPSQ Word64 (IO ())
forall p v q w.
(Int -> p -> v -> (q, w)) -> IntPSQ p v -> IntPSQ q w
IntPSQ.unsafeMapMonotonic Int -> Word64 -> IO () -> (Word64, IO ())
g IntPSQ Word64 (IO ())
alive))
  where
    f :: (Int, Word64, IO ()) -> IO ()
    f :: (Int, Word64, IO ()) -> IO ()
f (Int
_, Word64
_, IO ()
m) =
      IO ()
m
    g :: Int -> Word64 -> IO () -> (Word64, IO ())
    g :: Int -> Word64 -> IO () -> (Word64, IO ())
g Int
_ Word64
n IO ()
m =
      (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1, IO ()
m)
{-# INLINEABLE partition #-}