PolicySpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Shibuya.PolicySpec (spec) where

import Shibuya.Core.Error (PolicyError (..))
import Shibuya.Policy
import Test.Hspec

spec :: Spec
spec = do
  describe "OrderingPolicy" $ do
    it "all constructors are distinguishable" $ do
      StrictInOrder `shouldNotBe` PartitionedInOrder
      PartitionedInOrder `shouldNotBe` Unordered
      StrictInOrder `shouldNotBe` Unordered

  describe "Concurrency" $ do
    it "all constructors are distinguishable" $ do
      Serial `shouldNotBe` Ahead 1
      Ahead 1 `shouldNotBe` Async 1
      Serial `shouldNotBe` Async 1

    it "Ahead preserves Int value" $ do
      let c = Ahead 42
      case c of
        Ahead n -> n `shouldBe` 42
        _ -> expectationFailure "wrong constructor"

    it "Async preserves Int value" $ do
      let c = Async 100
      case c of
        Async n -> n `shouldBe` 100
        _ -> expectationFailure "wrong constructor"

  describe "validatePolicy" $ do
    describe "StrictInOrder" $ do
      it "allows Serial" $ do
        validatePolicy StrictInOrder Serial `shouldBe` Right ()

      it "rejects Ahead" $ do
        validatePolicy StrictInOrder (Ahead 5) `shouldSatisfy` isLeft

      it "rejects Async" $ do
        validatePolicy StrictInOrder (Async 5) `shouldSatisfy` isLeft

    describe "PartitionedInOrder" $ do
      it "allows Serial" $ do
        validatePolicy PartitionedInOrder Serial `shouldBe` Right ()

      it "allows Ahead" $ do
        validatePolicy PartitionedInOrder (Ahead 10) `shouldBe` Right ()

      it "allows Async" $ do
        validatePolicy PartitionedInOrder (Async 10) `shouldBe` Right ()

    describe "Unordered" $ do
      it "allows Serial" $ do
        validatePolicy Unordered Serial `shouldBe` Right ()

      it "allows Ahead" $ do
        validatePolicy Unordered (Ahead 10) `shouldBe` Right ()

      it "allows Async" $ do
        validatePolicy Unordered (Async 10) `shouldBe` Right ()

    describe "resource bounds" $ do
      mapM_
        ( \concurrency ->
            it ("rejects nonpositive " <> show concurrency) $
              validatePolicy Unordered concurrency `shouldBe` Left (InvalidConcurrency 0)
        )
        [Ahead 0, Async 0]

      mapM_
        ( \concurrency ->
            it ("rejects negative " <> show concurrency) $
              validatePolicy PartitionedInOrder concurrency `shouldBe` Left (InvalidConcurrency (-1))
        )
        [Ahead (-1), Async (-1)]

      let overflowing = maxBound `div` 2 + 1
      mapM_
        ( \concurrency ->
            it ("rejects derived-capacity overflow for " <> show concurrency) $
              validatePolicy Unordered concurrency `shouldBe` Left (ConcurrencyCapacityOverflow overflowing)
        )
        [Ahead overflowing, Async overflowing]

    describe "validatePolicy matrix" $ do
      let ok = True
          rejected = False
          cases =
            [ (StrictInOrder, Serial, ok),
              (StrictInOrder, Ahead 4, rejected),
              (StrictInOrder, Async 4, rejected),
              (PartitionedInOrder, Serial, ok),
              (PartitionedInOrder, Ahead 4, ok),
              (PartitionedInOrder, Async 4, ok),
              (Unordered, Serial, ok),
              (Unordered, Ahead 4, ok),
              (Unordered, Async 4, ok)
            ]
      mapM_
        ( \(ordering, concurrency, expected) ->
            it (show ordering <> " + " <> show concurrency) $
              isRight (validatePolicy ordering concurrency) `shouldBe` expected
        )
        cases

-- Helper
isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft (Right _) = False

isRight :: Either a b -> Bool
isRight (Right _) = True
isRight (Left _) = False