{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Test.Cardano.Chain.Common.Compact (
  tests,
) where

import Cardano.Chain.Common (fromCompactAddress, toCompactAddress)
import Cardano.HeapWords (HeapWords (..))
import Cardano.Prelude
import Hedgehog (MonadTest, assert, forAll, property, tripping)
import Test.Cardano.Chain.Common.Gen (genAddress)
import Test.Cardano.Prelude (discoverPropArg, discoverRoundTripArg)
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS, withTestsTS)

--------------------------------------------------------------------------------
-- Compact Address
--------------------------------------------------------------------------------

ts_roundTripCompactAddress :: TSProperty
ts_roundTripCompactAddress :: TSProperty
ts_roundTripCompactAddress =
  TestLimit
-> Gen Address -> (Address -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Address
genAddress ((Address -> CompactAddress)
-> (CompactAddress -> Address) -> Address -> PropertyT IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
(a -> b) -> (b -> a) -> a -> m ()
trippingCompact Address -> CompactAddress
toCompactAddress CompactAddress -> Address
fromCompactAddress)

ts_prop_heapWordsSavingsCompactAddress :: TSProperty
ts_prop_heapWordsSavingsCompactAddress :: TSProperty
ts_prop_heapWordsSavingsCompactAddress = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000
  (Property -> TSProperty) -> Property -> TSProperty
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property
  (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    addr <- Gen Address -> PropertyT IO Address
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Address
genAddress
    let compactAddr = Address -> CompactAddress
toCompactAddress Address
addr
    assert $ heapWords compactAddr < heapWords addr

--------------------------------------------------------------------------------
-- Tripping util
--------------------------------------------------------------------------------

trippingCompact ::
  (HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
  (a -> b) ->
  (b -> a) ->
  a ->
  m ()
trippingCompact :: forall (m :: * -> *) a b.
(HasCallStack, MonadTest m, Show a, Show b, Eq a) =>
(a -> b) -> (b -> a) -> a -> m ()
trippingCompact a -> b
toCompact b -> a
fromCompact a
x =
  a -> (a -> b) -> (b -> Identity a) -> m ()
forall (m :: * -> *) (f :: * -> *) b a.
(MonadTest m, Applicative f, Show b, Show (f a), Eq (f a),
 HasCallStack) =>
a -> (a -> b) -> (b -> f a) -> m ()
tripping a
x a -> b
toCompact (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (b -> a) -> b -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> a
fromCompact)

--------------------------------------------------------------------------------
-- Main test export
--------------------------------------------------------------------------------

tests :: TSGroup
tests :: TSGroup
tests = [TSGroup] -> TSGroup
concatTSGroups [$$discoverPropArg, $$discoverRoundTripArg]