ReorderSpec.hs

module Data.MediaBus.Conduit.ReorderSpec
  ( spec
  ) where

import Conduit
import Control.Monad
import Data.Conduit.List
import Data.MediaBus
import Data.Proxy
import Data.Word
import Debug.Trace
import Test.Hspec
import Test.QuickCheck

spec :: Spec
spec =
  describe "reorderFramesBySeqNumC" $ do
    let runC inputs =
          runConduitPure
            (sourceList inputs .|
             annotateTypeC
               (Proxy :: Proxy (Stream () TestSeqNumType () () ()))
               (reorderFramesBySeqNumC 3) .|
             consume)
    it "yields at least one 'Start' for each incoming 'Start'" $
      property $ \inputs ->
        let countStarts =
              foldr
                (\x n ->
                   case x of
                     MkStream (Start _) -> n + 1
                     MkStream (Next _) -> n)
                0
        in countStarts (runC inputs) `shouldSatisfy` (>= countStarts inputs)
    it "yields exactly the given input if the input is ordered and gap-free" $
      let inputs = [startFrame 0] ++ [nextFrame x | x <- [0 .. 10]]
      in runC inputs `shouldBe` inputs
    it "reorders out of order packets (1)" $
      let inputs =
            [startFrame 0, nextFrame 0, nextFrame 2, nextFrame 3, nextFrame 1]
          expected =
            [startFrame 0, nextFrame 0, nextFrame 1, nextFrame 2, nextFrame 3]
      in runC inputs `shouldBe` expected
    it "reorders out of order packets (2)" $
      let inputs = [startFrame 0, nextFrame 2, nextFrame 1, nextFrame 0]
          expected = [startFrame 0, nextFrame 0, nextFrame 1, nextFrame 2]
      in runC inputs `shouldBe` expected
    it "skips over missing frames when the queue is full" $
      let inputs =
            [ startFrame 0
            , nextFrame 0
            , nextFrame 1
            , nextFrame 3
            , nextFrame 4
            , nextFrame 5
            ]
          expected =
            [ startFrame 0
            , nextFrame 0
            , nextFrame 1
            , nextFrame 3
            , nextFrame 4
            , nextFrame 5
            ]
      in runC inputs `shouldBe` expected
    it "restarts at the incoming sequence numbering after too many frame drops" $
      let inputs =
            [ startFrame 10
            , nextFrame 10
            , nextFrame 11
            , nextFrame 12
            , nextFrame 0
            , nextFrame 1
            , nextFrame 2
            , nextFrame 3
            , nextFrame 4
            ]
          expected =
            [ startFrame 10
            , nextFrame 10
            , nextFrame 11
            , nextFrame 12
            , startFrame 2
            , nextFrame 2
            , nextFrame 3
            , nextFrame 4
            ]
      in runC inputs `shouldBe` expected
    it
      "restarts at the incoming sequence numbering after too many frame drops, AND flushes the queued elements first" $
      let inputs =
            [ startFrame 10
            , nextFrame 13
            , nextFrame 14
            , nextFrame 0
            , nextFrame 1
            , nextFrame 2
            , nextFrame 3
            , nextFrame 4
            ]
          expected =
            [ startFrame 10
            , nextFrame 13
            , nextFrame 14
            , startFrame 2
            , nextFrame 2
            , nextFrame 3
            , nextFrame 4
            ]
      in runC inputs `shouldBe` expected
    it "flushes and resets its internal state after every 'Start'" $
      let inputs =
            [ startFrame 10
            , nextFrame 13
            , nextFrame 14
            , startFrame 40
            , nextFrame 40
            , nextFrame 41
            , startFrame 50
            , nextFrame 0
            , nextFrame 1
            , startFrame 60
            , nextFrame 50
            , nextFrame 51
            , nextFrame 52
            ]
          expected =
            [ startFrame 10
            , nextFrame 13
            , nextFrame 14
            , startFrame 40
            , nextFrame 40
            , nextFrame 41
            , startFrame 50
            , startFrame 60
            , startFrame 52
            , nextFrame 52
            ]
      in runC inputs `shouldBe` expected
    it "yields monotone increasing frames higher than the start-frame" $
      property $ \inputs ->
        let os = runC inputs
        in when
             (not (isMonoIncreasingAndHigherThanStartSeqNum os))
             (trace
                (unlines $
                 ((("IN:   " ++) <$> show <$> inputs) ++ (("OUT:  " ++) <$> show <$>
                  os)))
                os `shouldSatisfy`
              isMonoIncreasingAndHigherThanStartSeqNum)

isMonoIncreasingAndHigherThanStartSeqNum :: [Stream () TestSeqNumType () () ()]
                                         -> Bool
isMonoIncreasingAndHigherThanStartSeqNum [] = True
isMonoIncreasingAndHigherThanStartSeqNum (MkStream (Start (MkFrameCtx () () sn ())):rest) =
  isMonoIncreasingAndHigherThanStartSeqNumN sn rest
isMonoIncreasingAndHigherThanStartSeqNum rest@(MkStream (Next (MkFrame () sn ())):_) =
  isMonoIncreasingAndHigherThanStartSeqNumN sn rest

isMonoIncreasingAndHigherThanStartSeqNumN _ [] = True
isMonoIncreasingAndHigherThanStartSeqNumN _ (MkStream (Start (MkFrameCtx () () sn ())):rest) =
  isMonoIncreasingAndHigherThanStartSeqNumN sn rest
isMonoIncreasingAndHigherThanStartSeqNumN sn (MkStream (Next (MkFrame () snFrame ())):rest)
  | snFrame >= sn = isMonoIncreasingAndHigherThanStartSeqNumN snFrame rest
  | otherwise = False

startFrame :: TestSeqNumType -> Stream () TestSeqNumType () () ()
startFrame sn = MkStream (Start (MkFrameCtx () () sn ()))

nextFrame :: TestSeqNumType -> Stream () TestSeqNumType () () ()
nextFrame sn = MkStream (Next (MkFrame () sn ()))

type TestSeqNumType = Word64