{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Data.OSet.StrictSpec where

import Cardano.Ledger.Binary (natVersion)
import Control.Monad (forM_)
import Data.OSet.Strict hiding (empty)
import Data.Sequence.Strict (StrictSeq, (><))
import qualified Data.Sequence.Strict as SSeq (fromList)
import Data.Set (Set, elems, empty)
import Test.Cardano.Base.QuickCheck (testLawsGroup)
import Test.Cardano.Data.Arbitrary ()
import Test.Cardano.Ledger.Binary.RoundTrip (cborTrip, embedTripSpec, roundTripCborSpec)
import Test.Cardano.StrictContainers.Instances ()
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck.Classes

spec :: Spec
spec :: Spec
spec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"OSet.Strict" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"membership checks work" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (OSet Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"unconsed" ((OSet Int -> IO ()) -> Spec) -> (OSet Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(OSet Int
s :: OSet Int) -> case OSet Int
s of
        OSet Int
Empty -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Int
x :<|: OSet Int
_xs -> Int
x Int -> (Int -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` (Int -> OSet Int -> Bool
forall a. Ord a => a -> OSet a -> Bool
`member` OSet Int
s)
      String -> (OSet Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"unsnoced" ((OSet Int -> IO ()) -> Spec) -> (OSet Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(OSet Int
s :: OSet Int) -> case OSet Int
s of
        OSet Int
Empty -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        OSet Int
_xs :|>: Int
x -> Int
x Int -> (Int -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` (Int -> OSet Int -> Bool
forall a. Ord a => a -> OSet a -> Bool
`member` OSet Int
s)
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"when cons-ing" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (OSet Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"adding a duplicate results in a no-op" ((OSet Int -> IO ()) -> Spec) -> (OSet Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(OSet Int
s :: OSet Int) -> do
        case OSet Int
s of
          OSet Int
Empty -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Int
x :<|: OSet Int
_xs -> OSet Int
s OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
x Int -> OSet Int -> OSet Int
forall a. Ord a => a -> OSet a -> OSet a
<| OSet Int
s
        case OSet Int
s of
          OSet Int
Empty -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          OSet Int
_xs :|>: Int
x -> OSet Int
s OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
x Int -> OSet Int -> OSet Int
forall a. Ord a => a -> OSet a -> OSet a
<| OSet Int
s
      String -> ((OSet Int, Int) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"new values get added" (((OSet Int, Int) -> IO ()) -> Spec)
-> ((OSet Int, Int) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \((OSet Int
s, Int
i) :: (OSet Int, Int)) -> do
        if Int
i Int -> OSet Int -> Bool
forall a. Ord a => a -> OSet a -> Bool
`member` OSet Int
s
          then Int
i Int -> OSet Int -> OSet Int
forall a. Ord a => a -> OSet a -> OSet a
<| OSet Int
s OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
s
          else Int
i Int -> OSet Int -> OSet Int
forall a. Ord a => a -> OSet a -> OSet a
<| OSet Int
s OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
i Int -> OSet Int -> OSet Int
forall a. Ord a => a -> OSet a -> OSet a
:<|: OSet Int
s
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"when snoc-ing" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (OSet Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"adding a duplicate results in a no-op" ((OSet Int -> IO ()) -> Spec) -> (OSet Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(OSet Int
s :: OSet Int) -> do
        case OSet Int
s of
          OSet Int
Empty -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Int
x :<|: OSet Int
_xs -> OSet Int
s OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
s OSet Int -> Int -> OSet Int
forall a. Ord a => OSet a -> a -> OSet a
|> Int
x
        case OSet Int
s of
          OSet Int
Empty -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          OSet Int
_xs :|>: Int
x -> OSet Int
s OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
s OSet Int -> Int -> OSet Int
forall a. Ord a => OSet a -> a -> OSet a
|> Int
x
      String -> ((OSet Int, Int) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"new values get added" (((OSet Int, Int) -> IO ()) -> Spec)
-> ((OSet Int, Int) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \((OSet Int
s, Int
i) :: (OSet Int, Int)) -> do
        if Int
i Int -> OSet Int -> Bool
forall a. Ord a => a -> OSet a -> Bool
`member` OSet Int
s
          then OSet Int
s OSet Int -> Int -> OSet Int
forall a. Ord a => OSet a -> a -> OSet a
|> Int
i OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
s
          else OSet Int
s OSet Int -> Int -> OSet Int
forall a. Ord a => OSet a -> a -> OSet a
|> Int
i OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
s OSet Int -> Int -> OSet Int
forall a. Ord a => OSet a -> a -> OSet a
:|>: Int
i
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"mappend preserves uniqueness" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (OSet Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"mappending with itself should be a no-op" ((OSet Int -> IO ()) -> Spec) -> (OSet Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(OSet Int
i :: OSet Int) -> do
        OSet Int
i OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
|>< OSet Int
i OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
i
        OSet Int
i OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
><| OSet Int
i OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
i
      String -> ((OSet Int, OSet Int) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"mappending with duplicates: left-preserving" (((OSet Int, OSet Int) -> IO ()) -> Spec)
-> ((OSet Int, OSet Int) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \((OSet Int
i, OSet Int
j) :: (OSet Int, OSet Int)) -> do
        case OSet Int
j of
          OSet Int
Empty -> OSet Int
i OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
i OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
|>< OSet Int
j
          Int
j' :<|: OSet Int
_js -> OSet Int
i OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
|>< OSet Int
j OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` (OSet Int
i OSet Int -> Int -> OSet Int
forall a. Ord a => OSet a -> a -> OSet a
|> Int
j') OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
|>< OSet Int
j
      String -> ((OSet Int, OSet Int) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"mappending with duplicates: right-preserving" (((OSet Int, OSet Int) -> IO ()) -> Spec)
-> ((OSet Int, OSet Int) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \((OSet Int
i, OSet Int
j) :: (OSet Int, OSet Int)) -> do
        case OSet Int
i of
          OSet Int
Empty -> OSet Int
i OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
><| OSet Int
j OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
j
          OSet Int
_is :|>: Int
i' -> OSet Int
i OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
><| OSet Int
j OSet Int -> OSet Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Int
i OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
><| (Int
i' Int -> OSet Int -> OSet Int
forall a. Ord a => a -> OSet a -> OSet a
<| OSet Int
j)
    String
-> ((OSet Int, OSet Int, StrictSeq Int, Set Int) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"operations preserve invariant" (((OSet Int, OSet Int, StrictSeq Int, Set Int) -> IO ()) -> Spec)
-> ((OSet Int, OSet Int, StrictSeq Int, Set Int) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      \((OSet Int
oset, OSet Int
oset', StrictSeq Int
sseq, Set Int
set) :: (OSet Int, OSet Int, StrictSeq Int, Set Int)) -> do
        OSet Int
oset OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
|>< OSet Int
oset' OSet Int -> (OSet Int -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` OSet Int -> Bool
forall a. Ord a => OSet a -> Bool
invariantHolds'
        OSet Int
oset OSet Int -> OSet Int -> OSet Int
forall a. Ord a => OSet a -> OSet a -> OSet a
><| OSet Int
oset' OSet Int -> (OSet Int -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` OSet Int -> Bool
forall a. Ord a => OSet a -> Bool
invariantHolds'
        StrictSeq Int -> OSet Int
forall a. Ord a => StrictSeq a -> OSet a
fromStrictSeq StrictSeq Int
sseq OSet Int -> (OSet Int -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` OSet Int -> Bool
forall a. Ord a => OSet a -> Bool
invariantHolds'
        Set Int -> OSet Int
forall a. Set a -> OSet a
fromSet Set Int
set OSet Int -> (OSet Int -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` OSet Int -> Bool
forall a. Ord a => OSet a -> Bool
invariantHolds'
    String -> (Set Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"fromList preserves order" ((Set Int -> IO ()) -> Spec) -> (Set Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(Set Int
set :: Set Int) ->
        let sseq :: StrictSeq Int
sseq = [Int] -> StrictSeq Int
forall a. [a] -> StrictSeq a
SSeq.fromList ([Int] -> StrictSeq Int) -> [Int] -> StrictSeq Int
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
elems Set Int
set
         in OSet Int -> StrictSeq Int
forall a. OSet a -> StrictSeq a
toStrictSeq ([Int] -> OSet Int
forall a. Ord a => [a] -> OSet a
fromList (Set Int -> [Int]
forall a. Set a -> [a]
elems Set Int
set)) StrictSeq Int -> StrictSeq Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` StrictSeq Int
sseq
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"fromStrictSeqDuplicates" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (Set Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"with duplicates" ((Set Int -> IO ()) -> Spec) -> (Set Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(Set Int
set :: (Set Int)) ->
        let sseq :: StrictSeq Int
sseq = [Int] -> StrictSeq Int
forall a. [a] -> StrictSeq a
SSeq.fromList ([Int] -> StrictSeq Int) -> [Int] -> StrictSeq Int
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
elems Set Int
set
            oset :: OSet Int
oset = StrictSeq Int -> OSet Int
forall a. Ord a => StrictSeq a -> OSet a
fromStrictSeq StrictSeq Int
sseq
         in StrictSeq Int -> (Set Int, OSet Int)
forall a. Ord a => StrictSeq a -> (Set a, OSet a)
fromStrictSeqDuplicates (StrictSeq Int
sseq StrictSeq Int -> StrictSeq Int -> StrictSeq Int
forall a. StrictSeq a -> StrictSeq a -> StrictSeq a
>< StrictSeq Int
sseq) (Set Int, OSet Int) -> (Set Int, OSet Int) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` (Set Int
set, OSet Int
oset)
      String -> (Set Int -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"without duplicates" ((Set Int -> IO ()) -> Spec) -> (Set Int -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \(Set Int
set :: (Set Int)) ->
        let sseq :: StrictSeq Int
sseq = [Int] -> StrictSeq Int
forall a. [a] -> StrictSeq a
SSeq.fromList ([Int] -> StrictSeq Int) -> [Int] -> StrictSeq Int
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
elems Set Int
set
            oset :: OSet Int
oset = StrictSeq Int -> OSet Int
forall a. Ord a => StrictSeq a -> OSet a
fromStrictSeq StrictSeq Int
sseq
         in StrictSeq Int -> (Set Int, OSet Int)
forall a. Ord a => StrictSeq a -> (Set a, OSet a)
fromStrictSeqDuplicates StrictSeq Int
sseq (Set Int, OSet Int) -> (Set Int, OSet Int) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` (Set Int
forall a. Set a
empty, OSet Int
oset)
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"CBOR round-trip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(OSet Int)
      forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(OSet (OSet Int))
      [Version] -> (Version -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9 .. Version
forall a. Bounded a => a
maxBound] ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \Version
v -> do
        Version
-> Version
-> Trip (Set Word) (OSet Word)
-> (OSet Word -> Set Word -> IO ())
-> Spec
forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> IO ()) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(Set Word) @(OSet Word)) ((OSet Word -> Set Word -> IO ()) -> Spec)
-> (OSet Word -> Set Word -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
          \OSet Word
oset Set Word
set -> Set Word
set Set Word -> Set Word -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` OSet Word -> Set Word
forall a. OSet a -> Set a
toSet OSet Word
oset
        Version
-> Version
-> Trip (OSet Word) (Set Word)
-> (Set Word -> OSet Word -> IO ())
-> Spec
forall a b.
(Show a, Typeable a, Typeable b, Arbitrary a, Eq b,
 HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> IO ()) -> Spec
embedTripSpec Version
v Version
v (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @(OSet Word) @(Set Word)) ((Set Word -> OSet Word -> IO ()) -> Spec)
-> (Set Word -> OSet Word -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
          \Set Word
set OSet Word
oset -> OSet Word -> Set Word
forall a. OSet a -> Set a
toSet OSet Word
oset Set Word -> Set Word -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Set Word
set
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"Typeclass laws" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
      forall a. [Proxy a -> Laws] -> Spec
testLawsGroup @(OSet Int)
        [ Proxy (OSet Int) -> Laws
forall a. (Eq a, Arbitrary a, Show a) => Proxy a -> Laws
eqLaws
        , Proxy (OSet Int) -> Laws
forall a. (Ord a, Arbitrary a, Show a) => Proxy a -> Laws
ordLaws
        , Proxy (OSet Int) -> Laws
forall a.
(IsList a, Show a, Show (Item a), Arbitrary a, Arbitrary (Item a),
 Eq a) =>
Proxy a -> Laws
isListLaws
        , Proxy (OSet Int) -> Laws
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Laws
semigroupLaws
        , Proxy (OSet Int) -> Laws
forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
monoidLaws
        , Proxy (OSet Int) -> Laws
forall a.
(Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Laws
semigroupMonoidLaws
        ]