Add test cases for: isEmpty, intersection, overlaps

plutus-ledger-api/plutus-ledger-api.cabal

@@ -63,6 +63,7 @@ library
         cardano-crypto -any,
         flat -any,
         hashable -any,
+        hedgehog -any,
         plutus-core -any,
         memory -any,
         mtl -any,
@@ -83,8 +84,12 @@ test-suite plutus-ledger-api-test
     type: exitcode-stdio-1.0
     main-is: Spec.hs
     hs-source-dirs: test
+    other-modules:
+        Spec.Interval
     build-depends:
         base >=4.9 && <5,
         plutus-ledger-api -any,
+        hedgehog -any,
         tasty -any,
+        tasty-hedgehog -any,
         tasty-hunit -any

plutus-ledger-api/test/Spec.hs

@@ -7,6 +7,7 @@ import           Data.Either
 import           Data.Maybe
 import           Plutus.V1.Ledger.Api
 import           Plutus.V1.Ledger.Examples
+import qualified Spec.Interval
 
 main :: IO ()
 main = defaultMain tests
@@ -25,4 +26,5 @@ tests :: TestTree
 tests = testGroup "plutus-ledger-api" [
     alwaysTrue
     , alwaysFalse
+    , Spec.Interval.tests
     ]

plutus-ledger-api/test/Spec/Interval.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Spec.Interval where
+
+import           Data.List                 (sort)
+import           Hedgehog                  (Property, forAll, property)
+import qualified Hedgehog
+import qualified Hedgehog.Gen              as Gen
+import qualified Hedgehog.Range            as Range
+import qualified Plutus.V1.Ledger.Interval as Interval
+import           Plutus.V1.Ledger.Slot
+import           Test.Tasty
+import           Test.Tasty.HUnit
+import           Test.Tasty.Hedgehog       (testProperty)
+
+alwaysIsNotEmpty :: TestTree
+alwaysIsNotEmpty =
+  testCase "always is not empty" $
+    assertBool "always" (not $ Interval.isEmpty (Interval.always :: Interval.Interval Slot))
+
+neverIsEmpty :: TestTree
+neverIsEmpty =
+  testCase "never is empty" $
+    assertBool "never" (Interval.isEmpty (Interval.never :: Interval.Interval Slot))
+
+intvlIsEmpty :: Property
+intvlIsEmpty = property $ do
+  (i1, i2) <- forAll $ (,) <$> Gen.integral (fromIntegral <$> Range.linearBounded @Int) <*> Gen.integral (fromIntegral <$> Range.linearBounded @Int)
+  let (from, to) = (min i1 i2, max i1 i2)
+      nonEmpty = Interval.interval (Slot from) (Slot to)
+      empty = Interval.interval (Slot to) (Slot from)
+  Hedgehog.assert $ from == to || Interval.isEmpty empty
+  Hedgehog.assert $ not $ Interval.isEmpty nonEmpty
+
+intvlIntersection :: Property
+intvlIntersection = property $ do
+  ints <- forAll $ traverse (const $ Gen.integral (fromIntegral <$> Range.linearBounded @Int)) [1 .. 4]
+  let [i1, i2, i3, i4] = Slot <$> sort ints
+      outer = Interval.interval i1 i4
+      inner = Interval.interval i2 i3
+      intersec = outer `Interval.intersection` inner
+
+      lower = Interval.interval i1 i2
+      higher = Interval.interval i2 i3
+      common = Interval.interval i2 i2
+      intersec2 = lower `Interval.intersection` higher
+
+  Hedgehog.assert $ intersec == inner
+  Hedgehog.assert $ intersec2 == common
+
+intvlIntersectionWithAlwaysNever :: Property
+intvlIntersectionWithAlwaysNever = property $ do
+  (i1, i2) <- forAll $ (,) <$> Gen.integral (fromIntegral <$> Range.linearBounded @Int) <*> Gen.integral (fromIntegral <$> Range.linearBounded @Int)
+  let (from, to) = (min i1 i2, max i1 i2)
+      i = Interval.interval (Slot from) (Slot to)
+      e = Interval.interval (Slot to) (Slot from)
+
+  Hedgehog.assert $ Interval.never == i `Interval.intersection` Interval.never
+  Hedgehog.assert $ i == i `Interval.intersection` Interval.always
+  Hedgehog.assert $ e == e `Interval.intersection` i
+
+intvlOverlaps :: Property
+intvlOverlaps = property $ do
+  (i1, i2) <- forAll $ (,) <$> Gen.integral (fromIntegral <$> Range.linearBounded @Int) <*> Gen.integral (fromIntegral <$> Range.linearBounded @Int)
+  let (from, to) = (min i1 i2, max i1 i2)
+      i = Interval.interval (Slot from) (Slot to)
+
+  Hedgehog.assert $ i `Interval.overlaps` i
+  Hedgehog.assert $ Interval.always `Interval.overlaps` i
+  Hedgehog.assert $ not $ Interval.never `Interval.overlaps` i
+
+tests :: TestTree
+tests =
+  testGroup
+    "plutus-ledger-api-interval"
+    [ neverIsEmpty
+    , alwaysIsNotEmpty
+    , testProperty "interval intersection" intvlIntersection
+    , testProperty "interval intersection with always/never" intvlIntersectionWithAlwaysNever
+    , testProperty "interval isEmpty" intvlIsEmpty
+    , testProperty "interval overlaps" intvlOverlaps
+    ]