{-# 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.Proxy
import Data.Sequence.Strict (StrictSeq, (><))
import qualified Data.Sequence.Strict as SSeq (fromList)
import Data.Set (Set, elems, empty)
import Test.Cardano.Data.Arbitrary ()
import Test.Cardano.Ledger.Binary.RoundTrip (cborTrip, embedTripSpec, roundTripCborSpec)
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
$ do
      String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Type" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
        Proxy (OSet Int) -> [Proxy (OSet Int) -> Laws] -> IO ()
forall a. Proxy a -> [Proxy a -> Laws] -> IO ()
lawsCheckOne
          (Proxy (OSet Int)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (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
          ]