numerus-closus 0.3.0.0 → 0.4.0.0

raw patch · 4 files changed

+51/−41 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• numerus-closus.cabal +1/−1
• src/Control/NumerusClosus.hs +7/−0
• src/Control/NumerusClosus/Typed.hs +15/−19
• test/Spec.hs +28/−21

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                numerus-closus-version:             0.3.0.0+version:             0.4.0.0 author:              Gautier DI FOLCO maintainer:          gautier.difolco@gmail.com category:            Scheduling

@@ -62,11 +62,18 @@     scheduleWith,     loopSchedule,     loopScheduleWith,++    -- * Reexports+    First (..),+    Last (..),+    Max (..),+    Min (..),   ) where  import qualified Control.NumerusClosus.Typed as Typed import qualified Data.List.NonEmpty as NE+import Data.Semigroup (First (..), Last (..), Max (..), Min (..)) import Data.Time (UTCTime (..))  -- * Main logic

@@ -61,6 +61,12 @@     scheduleWith,     loopSchedule,     loopScheduleWith,++    -- * Reexports+    First (..),+    Last (..),+    Max (..),+    Min (..),   ) where @@ -68,6 +74,7 @@ import Control.Monad (mfilter) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe)+import Data.Semigroup (First (..), Last (..), Max (..), Min (..)) import qualified Data.Set as Set import Data.Time (FormatTime, NominalDiffTime, ParseTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime) import GHC.Generics (Generic)@@ -82,16 +89,11 @@  -- | Represents when the next request can be debited. data NextDebitable-  = -- | The request will never be debitable again.-    Never-  | -- | The request can be debited from this time onwards.+  = -- | The request can be debited from this time onwards.     DebitableFrom UTCTime-  deriving stock (Eq, Show)--instance Semigroup NextDebitable where-  Never <> _ = Never-  _ <> Never = Never-  DebitableFrom x <> DebitableFrom y = DebitableFrom $ max x y+  | -- | The request will never be debitable again.+    Never+  deriving stock (Eq, Ord, Show)  -- * Base helpers @@ -289,9 +291,9 @@   debit (x :&& y) at =     case (debit x at, debit y at) of       (Right x', Right y') -> Right $ x' :&& y'-      (Left x', Left y') -> Left $ x' <> y'-      (Left x', _) -> Left x'-      (_, Left y') -> Left y'+      (Left x', Left y') -> Left $ getMax $ Max x' <> Max y'+      (Left x', _) -> Left $ getFirst $ First x'+      (_, Left y') -> Left $ getLast $ Last y'  -- | OR combinator type: allows a request if either rate limiter allows it. data a :|| b = a :|| b@@ -303,13 +305,7 @@   debit (x :|| y) at =     case (debit x at, debit y at) of       (Right x', Right y') -> Right $ x' :|| y'-      (Left x', Left y') ->-        Left $-          case (x', y') of-            (Never, Never) -> Never-            (DebitableFrom x'', DebitableFrom y'') -> DebitableFrom $ min x'' y''-            (DebitableFrom x'', _) -> DebitableFrom x''-            (_, DebitableFrom y'') -> DebitableFrom y''+      (Left x', Left y') -> Left $ getMin $ Min x' <> Min y'       (Right x', _) -> Right $ x' :|| y       (_, Right y') -> Right $ x :|| y' 

@@ -4,18 +4,16 @@  module Main (main) where -import Control.Monad (replicateM_)-import qualified Control.NumerusClosus as NC import Control.NumerusClosus ((.&&), (.||))-import Data.Either (isLeft, isRight)+import qualified Control.NumerusClosus as NC import Data.List.NonEmpty (NonEmpty ((:|)))-import qualified Data.List.NonEmpty as NE-import Data.Time (NominalDiffTime, UTCTime (..), addUTCTime, fromGregorian, secondsToNominalDiffTime)+import Data.Semigroup (Max (..), Min (..))+import Data.Time (UTCTime (..), addUTCTime, fromGregorian, secondsToNominalDiffTime) import qualified Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range-import Test.Hspec (Expectation, Spec, describe, hspec, it, shouldBe, shouldSatisfy)-import Test.Hspec.Hedgehog (PropertyT, forAll, hedgehog, (===))+import Test.Hspec (Expectation, Spec, describe, hspec, it, shouldBe)+import Test.Hspec.Hedgehog (forAll, hedgehog, (===))  main :: IO () main = hspec spec@@ -42,7 +40,7 @@  debitSequence :: [UTCTime] -> NC.RateLimiter -> Either NC.NextDebitable NC.RateLimiter debitSequence [] rl = Right rl-debitSequence (t:ts) rl = case NC.debit rl t of+debitSequence (t : ts) rl = case NC.debit rl t of   Right rl' -> debitSequence ts rl'   Left nd -> Left nd @@ -232,16 +230,25 @@         assertLeftNever $ NC.debit (NC.anyOf (rlDeny :| [rlDeny])) baseTime         assertRight $ NC.debit (NC.anyOf (rlDeny :| [rlAllow])) baseTime -    describe "NextDebitable Semigroup" do-      it "Never <> anything = Never" do-        NC.Never <> NC.DebitableFrom baseTime `shouldBe` NC.Never-        NC.DebitableFrom baseTime <> NC.Never `shouldBe` NC.Never+    describe "NextDebitable Min / Max" do+      it "Max Never (DebitableFrom t) = Max Never" do+        getMax (Max NC.Never <> Max (NC.DebitableFrom baseTime)) `shouldBe` NC.Never+        getMax (Max (NC.DebitableFrom baseTime) <> Max NC.Never) `shouldBe` NC.Never -      it "DebitableFrom x <> DebitableFrom y = DebitableFrom (max x y)" do+      it "Max (DebitableFrom x) (DebitableFrom y) = DebitableFrom (max x y)" do         let t1 = offsetTime 10             t2 = offsetTime 20-        NC.DebitableFrom t1 <> NC.DebitableFrom t2 `shouldBe` NC.DebitableFrom t2+        getMax (Max (NC.DebitableFrom t1) <> Max (NC.DebitableFrom t2)) `shouldBe` NC.DebitableFrom t2 +      it "Min Never (DebitableFrom t) = Min (DebitableFrom t)" do+        getMin (Min NC.Never <> Min (NC.DebitableFrom baseTime)) `shouldBe` NC.DebitableFrom baseTime+        getMin (Min (NC.DebitableFrom baseTime) <> Min NC.Never) `shouldBe` NC.DebitableFrom baseTime++      it "Min (DebitableFrom x) (DebitableFrom y) = DebitableFrom (min x y)" do+        let t1 = offsetTime 10+            t2 = offsetTime 20+        getMin (Min (NC.DebitableFrom t1) <> Min (NC.DebitableFrom t2)) `shouldBe` NC.DebitableFrom t1+     describe "scheduleWith" do       it "mock PositionInTime pure test" do         let mockPit = NC.PositionInTime {NC.getTime = pure baseTime, NC.delayUntil = \_ -> pure ()}@@ -265,16 +272,16 @@         Right _ -> pure ()         Left _ -> Hedgehog.failure -    it "NextDebitable semigroup associativity" $ hedgehog do+    it "NextDebitable Max semigroup associativity" $ hedgehog do       a <- forAll genNextDebitable       b <- forAll genNextDebitable       c <- forAll genNextDebitable-      (a <> b) <> c === a <> (b <> c)+      Max a <> (Max b <> Max c) === (Max a <> Max b) <> Max c -    it "NextDebitable semigroup Never absorption" $ hedgehog do+    it "NextDebitable Max Never absorption" $ hedgehog do       x <- forAll genNextDebitable-      NC.Never <> x === NC.Never-      x <> NC.Never === NC.Never+      Max NC.Never <> Max x === Max NC.Never+      Max x <> Max NC.Never === Max NC.Never      it "fixedWindow allows exactly maxBucket per window" $ hedgehog do       maxBucket <- forAll (Gen.integral (Range.linear 1 50))@@ -304,6 +311,6 @@ genNextDebitable :: Hedgehog.Gen NC.NextDebitable genNextDebitable =   Gen.choice-    [ pure NC.Never-    , NC.DebitableFrom <$> genUTCTime+    [ pure NC.Never,+      NC.DebitableFrom <$> genUTCTime     ]