bounded-queue (empty) → 1.0.0

raw patch · 5 files changed

+256/−0 lines, 5 filesdep +basedep +bounded-queuedep +containers

Dependencies added: base, bounded-queue, containers, deepseq, tasty, tasty-hunit

Files

LICENSE +30/−0
README.md +11/−0
bounded-queue.cabal +49/−0
lib/Data/Queue/Bounded.hs +123/−0
test/Test.hs +43/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Kadena LLC (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,11 @@+# bounded-queue++This library provides a strict, immutable, thread-safe, single-ended, bounded+queue. When the insert limit is reached and a `cons` is attempted, this `BQueue`+automatically drops old entries off its end. Thus, writes always succeed and+never block.++This data structure is intended as a "sliding window" over some stream of data,+where we wish old entries to be naturally forgotten. Since this is an immutable+data structure and not a concurrent queue, we provide instances for the usual+useful typeclasses with which one can perform analysis over the entire "window".

+ bounded-queue.cabal view

@@ -0,0 +1,49 @@+cabal-version: 2.2++name:           bounded-queue+version:        1.0.0+synopsis:       A strict, immutable, thread-safe, single-ended, bounded queue.+description:    A strict, immutable, thread-safe, single-ended, bounded queue+                which automatically forgets old values instead of blocking.+category:       Data+homepage:       https://gitlab.com/fosskers/bounded-queue+author:         Colin Woodbury+maintainer:     colin@kadena.io+copyright:      2019 Kadena LLC+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple++extra-source-files:+    README.md++common commons+    default-language: Haskell2010+    build-depends: base >= 4.7 && < 5+    ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns++library+    import: commons+    hs-source-dirs: lib+    exposed-modules: Data.Queue.Bounded+    build-depends: containers+                 , deepseq++test-suite bounded-queue-test+    import: commons+    type: exitcode-stdio-1.0+    hs-source-dirs: test+    main-is: Test.hs+    ghc-options: -threaded -with-rtsopts=-N+    build-depends: bounded-queue+                 , tasty >= 1.2+                 , tasty-hunit >= 0.10++-- benchmark bounded-queue-bench+--   import: commons+--   type: exitcode-stdio-1.0+--   hs-source-dirs: bench+--   main-is: Bench.hs+--   ghc-options: -threaded -O2 -with-rtsopts=-N+--   build-depends: bounded-queue+--                , criterion >= 1.5

+ lib/Data/Queue/Bounded.hs view

@@ -0,0 +1,123 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}++-- |+-- Module    : Data.Queue.Bounded+-- Copyright : (c) Kadena LLC, 2019+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@kadena.io>+--+-- This library provides a strict, immutable, thread-safe, single-ended, bounded+-- queue. When the insert limit is reached and a `cons` is attempted, this+-- `BQueue` automatically drops old entries off its end. Thus, writes always+-- succeed and never block.+--+-- This data structure is intended as a "sliding window" over some stream of+-- data, where we wish old entries to be naturally forgotten. Since this is an+-- immutable data structure and not a concurrent queue, we provide instances for+-- the usual useful typeclasses with which one can perform analysis over the+-- entire "window".+--+-- This module is intended to be imported qualified:+--+-- @+-- import qualified Data.Queue.Bounded as BQ+-- @++module Data.Queue.Bounded+  ( -- * Type+    BQueue()+    -- * Construction+  , empty, singleton, fromList+    -- * Insertion / Removal+  , cons, uncons+    -- * Extra+  , 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++---++-- | A single-ended, bounded queue which keeps track of its size.+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 #-}++-- | \(\mathcal{O}(1)\) `length` implementation.+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 (<>) #-}++-- | Given a limit value, yield an empty `BQueue`.+empty :: Int -> BQueue a+empty l = BQueue mempty l 0++-- | Given a limit value and an initial value, yield a singleton `BQueue`.+singleton :: Int -> a -> BQueue a+singleton l a = BQueue (Seq.singleton a) l 1++-- | \(\mathcal{O}(c)\). Naively keeps the first \(c\) values of the input list+-- (as defined by the given limiting `Int` value) and does not attempt any+-- elegant queue-like cycling.+fromList :: Int -> [a] -> BQueue a+fromList n list = BQueue (Seq.fromList list') n $ length list'+  where+    list' = P.take n list++-- | \(\mathcal{O}(1)\).+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)++-- | \(\mathcal{O}(1)\).+uncons :: BQueue a -> Maybe (a, BQueue a)+uncons (BQueue Empty _ _)     = Nothing+uncons (BQueue (h :<| t) l s) = Just (h, BQueue t l $ pred s)++-- | \(\mathcal{O}(n)\).+average :: Integral a => BQueue a -> a+average (BQueue q _ s) = floor $ foldl' (+) 0 q % fromIntegral s+{-# INLINE average #-}++-- | \(\mathcal{O}(n)\).+reverse :: BQueue a -> BQueue a+reverse (BQueue q l s) = BQueue (Seq.reverse q) l s++-- | \(\mathcal{O}(\log(\min(i,n-i)))\).+take :: Int -> BQueue a -> BQueue a+take n (BQueue q l s) = BQueue (Seq.take n q) l $ min n s++-- | \(\mathcal{O}(\log(\min(i,n-i)))\).+drop :: Int -> BQueue a -> BQueue a+drop n (BQueue q l s) = BQueue (Seq.drop n q) l $ max 0 (s - n)

+ test/Test.hs view

@@ -0,0 +1,43 @@+module Main where++import           Data.Foldable (foldl')+import qualified Data.Queue.Bounded as BQ+import           Test.Tasty+import           Test.Tasty.HUnit++---++main :: IO ()+main = defaultMain suite++suite :: TestTree+suite = testGroup "Unit Tests"+  [ testGroup "cons"+    [ testCase "Cycles Properly" cycles+    ]+  , testGroup "Misc."+    [ testCase "take few" takeFew+    , testCase "take many" takeMany+    , testCase "drop few" dropFew+    , testCase "drop many" dropMany+    ]+  ]++cycles :: Assertion+cycles = cycled @?= expected+  where+    cycled = foldl' (flip BQ.cons) orig [11..20]+    orig = BQ.fromList 10 ([1..10] :: [Int])+    expected = BQ.fromList 10 [20, 19 ..11]++takeFew :: Assertion+takeFew = length (BQ.take 5 $ BQ.fromList 10 ['a'..]) @?= 5++takeMany :: Assertion+takeMany = length (BQ.take 100 $ BQ.fromList 10 ['a'..]) @?= 10++dropFew :: Assertion+dropFew = length (BQ.drop 6 $ BQ.fromList 10 ['a'..]) @?= 4++dropMany :: Assertion+dropMany = length (BQ.drop 100 $ BQ.fromList 10 ['a'..]) @?= 0