/
RingBufferSpec.hs
75 lines (63 loc) · 2.77 KB
/
RingBufferSpec.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
{-# LANGUAGE LambdaCase #-}
module RingBufferSpec where
import Control.Monad (forM, liftM, replicateM)
import Data.Foldable (traverse_)
import Data.IORef (IORef, atomicModifyIORef, modifyIORef, newIORef, readIORef, writeIORef)
import Data.List (tails)
import Data.Maybe (catMaybes)
import GHC.Clock (getMonotonicTime)
import GHC.Natural (Natural)
import Test.Hspec (Spec, it, pending, shouldBe, shouldReturn)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (Positive (..), Property, arbitrary, counterexample, forAll, (==>))
import Test.QuickCheck.Monadic (assert, monadicIO, monitor, run)
-- a "ring" buffer where you can:
-- - push an element to the tail if not full
-- - pop an element from the head if not empty
-- - fixed capacity in the queue
spec :: Spec
spec = do
it "return nothing for pop of empty buffer" $ do
b <- newBuffer 0
pop b `shouldReturn` Nothing
it "return False when pushing on full buffer" $ do
b <- newBuffer 0
push b 42 `shouldReturn` False
prop "pushing an element then popping it gives back same element" pushPopIsIdempotence
prop "pushing and popping an element is in O(1)" bufferAccessTimeIsConstant
bufferAccessTimeIsConstant :: Property
bufferAccessTimeIsConstant =
forAll arbitrary $ \xs -> monadicIO $ do
let subs = tails xs
ys <- run $ forM subs $ \sublist -> do
buffer <- newBuffer (fromIntegral $ length sublist)
st <- getMonotonicTime
traverse_ (push buffer) sublist
replicateM (fromIntegral $ length sublist) (pop buffer)
end <- getMonotonicTime
pure (end - st)
monitor $ counterexample $ "popped from buffer: " <> show ys
assert (all (uncurry (==)) $ zip ys (tail ys))
pushPopIsIdempotence :: Property
pushPopIsIdempotence =
forAll arbitrary $ \xs ->
forAll arbitrary $ \(Positive capacity) ->
capacity <= length xs ==> monadicIO $ do
ys <- run $ do
buffer <- newBuffer (fromIntegral capacity)
traverse_ (push buffer) xs
replicateM (fromIntegral capacity) (pop buffer)
monitor $ counterexample $ "popped from buffer: " <> show ys
assert (take capacity xs == catMaybes ys)
pop :: RingBuffer -> IO (Maybe Int)
pop (RingBuffer _ ref) = do
atomicModifyIORef ref (\case (x : xs) -> (xs, Just x); [] -> ([], Nothing))
push :: RingBuffer -> Int -> IO Bool
push (RingBuffer capacity ref) x =
atomicModifyIORef ref $ \xs ->
if length xs < fromIntegral capacity
then (xs <> [x], True)
else (xs, False)
data RingBuffer = RingBuffer Natural (IORef [Int])
newBuffer :: Natural -> IO RingBuffer
newBuffer capacity = liftM (RingBuffer capacity) (newIORef [])