{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Ouroboros.Consensus.Protocol (tests_chainOrder) where

import           Data.Proxy
import           Data.Typeable (Typeable, typeRep)
import           Ouroboros.Consensus.Protocol.Abstract
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.Util.QuickCheck

-- | Test the laws of the 'ChainOrder' class (in particular, that 'Ord' is
-- lawful) /except/ for the high-level "Chain extension precedence" property.
tests_chainOrder ::
     forall a.
     ( ChainOrder a
     , Typeable a
     , Arbitrary a
     , Show a
     , Arbitrary (ChainOrderConfig a)
     , Show (ChainOrderConfig a)
     )
  => Proxy a
  -> TestTree
tests_chainOrder :: forall a.
(ChainOrder a, Typeable a, Arbitrary a, Show a,
 Arbitrary (ChainOrderConfig a), Show (ChainOrderConfig a)) =>
Proxy a -> TestTree
tests_chainOrder Proxy a
aPrx = TestName -> [TestTree] -> TestTree
testGroup (TestName
"ChainOrder " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TypeRep -> TestName
forall a. Show a => a -> TestName
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
aPrx))
    [ TestName -> (a -> a -> a -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Eq & Ord" (forall a. (Show a, Ord a) => a -> a -> a -> Property
prop_lawfulEqAndTotalOrd @a)
    , TestName -> (ChainOrderConfig a -> a -> a -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Consistency with Ord" ((ChainOrderConfig a -> a -> a -> Property) -> TestTree)
-> (ChainOrderConfig a -> a -> a -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \ChainOrderConfig a
cfg (a
a :: a) a
b ->
        ChainOrderConfig a -> a -> a -> Bool
forall sv. ChainOrder sv => ChainOrderConfig sv -> sv -> sv -> Bool
preferCandidate ChainOrderConfig a
cfg a
a a
b Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> a
a a -> a -> Property
forall a. (Ord a, Show a) => a -> a -> Property
`lt` a
b
    ]