{-# 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 =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen Address
genAddress (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
  forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
property
  forall a b. (a -> b) -> a -> b
$ do
    Address
addr <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Address
genAddress
    let compactAddr :: CompactAddress
compactAddr = Address -> CompactAddress
toCompactAddress Address
addr
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert forall a b. (a -> b) -> a -> b
$ forall a. HeapWords a => a -> Int
heapWords CompactAddress
compactAddr forall a. Ord a => a -> a -> Bool
< forall a. HeapWords a => a -> Int
heapWords Address
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 =
  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 (forall a. a -> Identity a
Identity 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]