{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.Queue.Bounded
(
BQueue()
, empty, singleton, fromList
, cons, uncons
, average
, reverse
, take, drop
) where
import Control.DeepSeq (NFData)
import Data.Foldable (foldl', toList)
import Data.Ratio ((%))
import Data.Sequence (Seq(..), (<|))
import qualified Data.Sequence as Seq
import GHC.Generics (Generic)
import Prelude hiding (drop, reverse, take)
import qualified Prelude as P
data BQueue a = BQueue
{ _bqs :: !(Seq a)
, _bqsLimit :: {-# UNPACK #-} !Int
, _bqsSize :: {-# UNPACK #-} !Int }
deriving (Eq, Generic, NFData)
instance Show a => Show (BQueue a) where
show (BQueue q _ _) = show $ toList q
instance Functor BQueue where
fmap f (BQueue q l s) = BQueue (f <$> q) l s
{-# INLINE fmap #-}
instance Foldable BQueue where
foldMap f (BQueue q _ _) = foldMap f q
{-# INLINE foldMap #-}
length (BQueue _ _ s) = s
instance Traversable BQueue where
traverse f (BQueue q l s) = (\q' -> BQueue q' l s) <$> traverse f q
{-# INLINE traverse #-}
instance Semigroup (BQueue a) where
(BQueue q l s) <> (BQueue q' l' s') = BQueue (q <> q') (l + l') (s + s')
{-# INLINE (<>) #-}
empty :: Int -> BQueue a
empty l = BQueue mempty l 0
singleton :: Int -> a -> BQueue a
singleton l a = BQueue (Seq.singleton a) l 1
fromList :: Int -> [a] -> BQueue a
fromList n list = BQueue (Seq.fromList list') n $ length list'
where
list' = P.take n list
cons :: a -> BQueue a -> BQueue a
cons a (BQueue Empty l _) = BQueue (Seq.singleton a) l 1
cons a (BQueue q@(rest :|> _) l s)
| s == l = BQueue (a <| rest) l s
| otherwise = BQueue (a <| q) l (succ s)
uncons :: BQueue a -> Maybe (a, BQueue a)
uncons (BQueue Empty _ _) = Nothing
uncons (BQueue (h :<| t) l s) = Just (h, BQueue t l $ pred s)
average :: Integral a => BQueue a -> a
average (BQueue q _ s) = floor $ foldl' (+) 0 q % fromIntegral s
{-# INLINE average #-}
reverse :: BQueue a -> BQueue a
reverse (BQueue q l s) = BQueue (Seq.reverse q) l s
take :: Int -> BQueue a -> BQueue a
take n (BQueue q l s) = BQueue (Seq.take n q) l $ min n s
drop :: Int -> BQueue a -> BQueue a
drop n (BQueue q l s) = BQueue (Seq.drop n q) l $ max 0 (s - n)