{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Rsv.Common
( RHandles(..)
, RHandle
, newHandles
, nextHandle
, checkHandle
, withHandle
, sEnqueue
, sUnqueue
, sDequeue
)
where
import qualified Data.Sequence.Internal as Seq
import Data.Sequence (Seq (..), (|>))
import Data.Word (Word64)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
newtype RHandles = RHandles { getNextHandle :: RHandle }
deriving (Show, Read, Generic, Eq)
newtype RHandle = RHandle { getHandle :: Word64 }
deriving (Show, Read, Generic, Eq, Ord, Enum, Bounded)
newHandles :: RHandles
newHandles = RHandles (RHandle 0)
nextHandle :: RHandles -> (RHandle, RHandles)
nextHandle (RHandles h) = (h, RHandles (succ h))
checkHandle :: RHandles -> RHandle -> Bool
checkHandle (RHandles hh) h = hh > h
withHandle
:: ((RHandle, i) -> c -> c) -> i -> (RHandles, c) -> (RHandle, (RHandles, c))
withHandle doWith item (handles0, container0) =
let (handle, handles1) = nextHandle handles0
container1 = doWith (handle, item) container0
in (handle, (handles1, container1))
sEnqueue :: a -> Seq a -> Seq a
sEnqueue x slm = slm |> x
sUnqueue :: (HasCallStack, Eq k) => k -> Seq (k, a) -> (Maybe a, Seq (k, a))
sUnqueue idx' slm = (snd <$> found', others)
where
(Seq.Seq found, others) = Seq.partition ((== idx') . fst) $ slm
found' = case found of
Seq.EmptyT -> Nothing
Seq.Single (Seq.Elem x) -> Just x
_ -> error "sUnqueue found more than one key"
sDequeue :: Seq a -> (Maybe a, Seq a)
sDequeue (h :<| t) = (Just h, t)
sDequeue Seq.Empty = (Nothing, Seq.Empty)