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