{-# LANGUAGE LambdaCase       #-}
{-# LANGUAGE TypeApplications #-}
-- | Check compatibility of Flat Natural to Flat Word64
-- needed for Index (de)serialization see Note [DeBruijn Index serialization]
module DeBruijn.FlatNatWord (test_flatNatWord) where

import PlutusCore.DeBruijn
import PlutusCore.Flat ()

import Data.Either (isLeft)
import Data.Word
import Flat
import Flat.Encoder
import GHC.Natural
import Hedgehog
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Test.Tasty
import Test.Tasty.Extras
import Test.Tasty.Hedgehog
import Test.Tasty.HUnit

-- test that Natural and Word64 are compatible inside
-- the (minBound,maxBound) bounds of Word64
prop_CompatInBounds :: TestTree
prop_CompatInBounds :: TestTree
prop_CompatInBounds = TestName -> Property -> TestTree
testProperty TestName
"compatible inside bounds" (Property -> TestTree) -> Property -> TestTree
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
    -- test that their encodings are byte-to-byte the same
    Word64
w <- Gen Word64 -> PropertyT IO Word64
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Word64 -> PropertyT IO Word64)
-> Gen Word64 -> PropertyT IO Word64
forall a b. (a -> b) -> a -> b
$ Range Word64 -> Gen Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
forall a. (Bounded a, Integral a) => Range a
Range.linearBounded
    let Natural
n :: Natural = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
    Word64 -> ByteString
forall a. Flat a => a -> ByteString
flat Word64
w ByteString -> ByteString -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Natural -> ByteString
forall a. Flat a => a -> ByteString
flat Natural
n

    -- Tripping from encoded as natural to decoded as word
    Word64
-> (Word64 -> ByteString)
-> (ByteString -> Either DecodeException Word64)
-> PropertyT IO ()
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 Word64
w (forall a. Flat a => a -> ByteString
flat @Natural (Natural -> ByteString)
-> (Word64 -> Natural) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ByteString -> Either DecodeException Word64
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat

    -- Tripping from encoded as word to decoded as natural
    Natural
-> (Natural -> ByteString)
-> (ByteString -> Either DecodeException Natural)
-> PropertyT IO ()
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 Natural
n (forall a. Flat a => a -> ByteString
flat @Word64 (Word64 -> ByteString)
-> (Natural -> Word64) -> Natural -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ByteString -> Either DecodeException Natural
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat

prop_DecLarger :: TestTree
prop_DecLarger :: TestTree
prop_DecLarger = TestName -> Property -> TestTree
testProperty TestName
"dec outside bounds" (Property -> TestTree) -> Property -> TestTree
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
    Natural
n <- Gen Natural -> PropertyT IO Natural
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Natural -> PropertyT IO Natural)
-> Gen Natural -> PropertyT IO Natural
forall a b. (a -> b) -> a -> b
$ Range Natural -> Gen Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Range Natural -> Gen Natural) -> Range Natural -> Gen Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.linear (Natural
maxWord64AsNatNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
+Natural
1) (Natural
maxWord64AsNatNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
*Natural
10)
    Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Hedgehog.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Either DecodeException Word64 -> Bool
forall a b. Either a b -> Bool
isLeft (Either DecodeException Word64 -> Bool)
-> Either DecodeException Word64 -> Bool
forall a b. (a -> b) -> a -> b
$ forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat @Word64 (ByteString -> Either DecodeException Word64)
-> ByteString -> Either DecodeException Word64
forall a b. (a -> b) -> a -> b
$ forall a. Flat a => a -> ByteString
flat @Natural Natural
n

test_MinBound :: TestTree
test_MinBound :: TestTree
test_MinBound = TestName -> Assertion -> TestTree
testCase TestName
"compatible minbound" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    let w :: Word64
w = forall a. Bounded a => a
minBound @Word64
        Natural
n :: Natural = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
    Word64 -> ByteString
forall a. Flat a => a -> ByteString
flat Word64
w ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> ByteString
forall a. Flat a => a -> ByteString
flat Natural
n Bool -> TestName -> Assertion
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> TestName -> Assertion
@? TestName
"enc minbound does not match"
    -- Tripping from encoded as natural to decoded as word
    Word64 -> Either DecodeException Word64
forall a b. b -> Either a b
Right Word64
w Either DecodeException Word64
-> Either DecodeException Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString -> Either DecodeException Word64
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (ByteString -> Either DecodeException Word64)
-> ByteString -> Either DecodeException Word64
forall a b. (a -> b) -> a -> b
$ Natural -> ByteString
forall a. Flat a => a -> ByteString
flat Natural
n)  Bool -> TestName -> Assertion
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> TestName -> Assertion
@? TestName
"tripping1 minbound failed"
    -- Tripping from encoded as word to decoded as natural
    Natural -> Either DecodeException Natural
forall a b. b -> Either a b
Right Natural
n Either DecodeException Natural
-> Either DecodeException Natural -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString -> Either DecodeException Natural
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (ByteString -> Either DecodeException Natural)
-> ByteString -> Either DecodeException Natural
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
forall a. Flat a => a -> ByteString
flat Word64
w) Bool -> TestName -> Assertion
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> TestName -> Assertion
@? TestName
"tripping1 minbound failed"

test_MaxBound :: TestTree
test_MaxBound :: TestTree
test_MaxBound = TestName -> Assertion -> TestTree
testCase TestName
"compatible maxbound" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    let w :: Word64
w = forall a. Bounded a => a
maxBound @Word64
        Natural
n :: Natural = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
    Word64 -> ByteString
forall a. Flat a => a -> ByteString
flat Word64
w ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> ByteString
forall a. Flat a => a -> ByteString
flat Natural
n Bool -> TestName -> Assertion
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> TestName -> Assertion
@? TestName
"enc maxbound does not match"
    -- Tripping from encoded as natural to decoded as word
    Word64 -> Either DecodeException Word64
forall a b. b -> Either a b
Right Word64
w Either DecodeException Word64
-> Either DecodeException Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString -> Either DecodeException Word64
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (ByteString -> Either DecodeException Word64)
-> ByteString -> Either DecodeException Word64
forall a b. (a -> b) -> a -> b
$ Natural -> ByteString
forall a. Flat a => a -> ByteString
flat Natural
n)  Bool -> TestName -> Assertion
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> TestName -> Assertion
@? TestName
"tripping1 maxbound failed"
    -- Tripping from encoded as word to decoded as natural
    Natural -> Either DecodeException Natural
forall a b. b -> Either a b
Right Natural
n Either DecodeException Natural
-> Either DecodeException Natural -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString -> Either DecodeException Natural
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (ByteString -> Either DecodeException Natural)
-> ByteString -> Either DecodeException Natural
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
forall a. Flat a => a -> ByteString
flat Word64
w) Bool -> TestName -> Assertion
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> TestName -> Assertion
@? TestName
"tripping1 maxbound failed"


prop_OldVsNewIndex :: TestTree
prop_OldVsNewIndex :: TestTree
prop_OldVsNewIndex = TestName -> Property -> TestTree
testProperty TestName
"oldVsNew Index" (Property -> TestTree) -> Property -> TestTree
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
    Natural
n <- Gen Natural -> PropertyT IO Natural
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen Natural -> PropertyT IO Natural)
-> Gen Natural -> PropertyT IO Natural
forall a b. (a -> b) -> a -> b
$ Range Natural -> Gen Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Range Natural -> Gen Natural) -> Range Natural -> Gen Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.linear Natural
minWord64AsNat (Natural
maxWord64AsNatNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
*Natural
10)
    let encoded :: ByteString
encoded = forall a. Flat a => a -> ByteString
flat @Natural Natural
n
        isCompatible :: Either a Index -> Either a OldIndex -> Bool
isCompatible = ((Either a Index, Either a OldIndex) -> Bool)
-> Either a Index -> Either a OldIndex -> Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((Either a Index, Either a OldIndex) -> Bool)
 -> Either a Index -> Either a OldIndex -> Bool)
-> ((Either a Index, Either a OldIndex) -> Bool)
-> Either a Index
-> Either a OldIndex
-> Bool
forall a b. (a -> b) -> a -> b
$ \case
            (Right (Index Word64
newDecoded), Right (OldIndex Word64
oldDecoded)) -> Word64
newDecoded Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
oldDecoded
            (Left a
_, Left a
_)                                        -> Bool
True
            (Either a Index, Either a OldIndex)
_                                                       -> Bool
False

    Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Hedgehog.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat @Index ByteString
encoded Decoded Index -> Either DecodeException OldIndex -> Bool
forall {a} {a}. Either a Index -> Either a OldIndex -> Bool
`isCompatible` forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat @OldIndex ByteString
encoded

test_flatNatWord :: TestNested
test_flatNatWord :: TestNested
test_flatNatWord =
    TestName -> [TestNested] -> TestNested
testNested TestName
"FlatNatWord" ([TestNested] -> TestNested) -> [TestNested] -> TestNested
forall a b. (a -> b) -> a -> b
$ (TestTree -> TestNested) -> [TestTree] -> [TestNested]
forall a b. (a -> b) -> [a] -> [b]
map TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed
        [ TestTree
test_MinBound
        , TestTree
test_MaxBound
        , TestTree
prop_CompatInBounds
        , TestTree
prop_DecLarger
        , TestTree
prop_OldVsNewIndex
        ]

-- * Old implementation of Flat Index copy-pasted and renamed to OldIndex

{- |
The old implementation relied on this function which is safe
*only* for 64-bit systems. There were previously safety checks to fail compilation
on other systems, but we removed them  since we only test on 64-bit systems afterall.
-}
naturalToWord64Maybe :: Natural -> Maybe Word64
naturalToWord64Maybe :: Natural -> Maybe Word64
naturalToWord64Maybe Natural
n = Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> Maybe Word -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Maybe Word
naturalToWordMaybe Natural
n
{-# INLINABLE naturalToWord64Maybe #-}

newtype OldIndex = OldIndex {OldIndex -> Word64
unOldIndex :: Word64}
  deriving stock ((forall x. OldIndex -> Rep OldIndex x)
-> (forall x. Rep OldIndex x -> OldIndex) -> Generic OldIndex
forall x. Rep OldIndex x -> OldIndex
forall x. OldIndex -> Rep OldIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OldIndex -> Rep OldIndex x
from :: forall x. OldIndex -> Rep OldIndex x
$cto :: forall x. Rep OldIndex x -> OldIndex
to :: forall x. Rep OldIndex x -> OldIndex
Generic)
  deriving newtype (Int -> OldIndex -> ShowS
[OldIndex] -> ShowS
OldIndex -> TestName
(Int -> OldIndex -> ShowS)
-> (OldIndex -> TestName) -> ([OldIndex] -> ShowS) -> Show OldIndex
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OldIndex -> ShowS
showsPrec :: Int -> OldIndex -> ShowS
$cshow :: OldIndex -> TestName
show :: OldIndex -> TestName
$cshowList :: [OldIndex] -> ShowS
showList :: [OldIndex] -> ShowS
Show, Integer -> OldIndex
OldIndex -> OldIndex
OldIndex -> OldIndex -> OldIndex
(OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex)
-> (OldIndex -> OldIndex)
-> (OldIndex -> OldIndex)
-> (Integer -> OldIndex)
-> Num OldIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: OldIndex -> OldIndex -> OldIndex
+ :: OldIndex -> OldIndex -> OldIndex
$c- :: OldIndex -> OldIndex -> OldIndex
- :: OldIndex -> OldIndex -> OldIndex
$c* :: OldIndex -> OldIndex -> OldIndex
* :: OldIndex -> OldIndex -> OldIndex
$cnegate :: OldIndex -> OldIndex
negate :: OldIndex -> OldIndex
$cabs :: OldIndex -> OldIndex
abs :: OldIndex -> OldIndex
$csignum :: OldIndex -> OldIndex
signum :: OldIndex -> OldIndex
$cfromInteger :: Integer -> OldIndex
fromInteger :: Integer -> OldIndex
Num, Int -> OldIndex
OldIndex -> Int
OldIndex -> [OldIndex]
OldIndex -> OldIndex
OldIndex -> OldIndex -> [OldIndex]
OldIndex -> OldIndex -> OldIndex -> [OldIndex]
(OldIndex -> OldIndex)
-> (OldIndex -> OldIndex)
-> (Int -> OldIndex)
-> (OldIndex -> Int)
-> (OldIndex -> [OldIndex])
-> (OldIndex -> OldIndex -> [OldIndex])
-> (OldIndex -> OldIndex -> [OldIndex])
-> (OldIndex -> OldIndex -> OldIndex -> [OldIndex])
-> Enum OldIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OldIndex -> OldIndex
succ :: OldIndex -> OldIndex
$cpred :: OldIndex -> OldIndex
pred :: OldIndex -> OldIndex
$ctoEnum :: Int -> OldIndex
toEnum :: Int -> OldIndex
$cfromEnum :: OldIndex -> Int
fromEnum :: OldIndex -> Int
$cenumFrom :: OldIndex -> [OldIndex]
enumFrom :: OldIndex -> [OldIndex]
$cenumFromThen :: OldIndex -> OldIndex -> [OldIndex]
enumFromThen :: OldIndex -> OldIndex -> [OldIndex]
$cenumFromTo :: OldIndex -> OldIndex -> [OldIndex]
enumFromTo :: OldIndex -> OldIndex -> [OldIndex]
$cenumFromThenTo :: OldIndex -> OldIndex -> OldIndex -> [OldIndex]
enumFromThenTo :: OldIndex -> OldIndex -> OldIndex -> [OldIndex]
Enum, Eq OldIndex
Eq OldIndex =>
(OldIndex -> OldIndex -> Ordering)
-> (OldIndex -> OldIndex -> Bool)
-> (OldIndex -> OldIndex -> Bool)
-> (OldIndex -> OldIndex -> Bool)
-> (OldIndex -> OldIndex -> Bool)
-> (OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex -> OldIndex)
-> Ord OldIndex
OldIndex -> OldIndex -> Bool
OldIndex -> OldIndex -> Ordering
OldIndex -> OldIndex -> OldIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OldIndex -> OldIndex -> Ordering
compare :: OldIndex -> OldIndex -> Ordering
$c< :: OldIndex -> OldIndex -> Bool
< :: OldIndex -> OldIndex -> Bool
$c<= :: OldIndex -> OldIndex -> Bool
<= :: OldIndex -> OldIndex -> Bool
$c> :: OldIndex -> OldIndex -> Bool
> :: OldIndex -> OldIndex -> Bool
$c>= :: OldIndex -> OldIndex -> Bool
>= :: OldIndex -> OldIndex -> Bool
$cmax :: OldIndex -> OldIndex -> OldIndex
max :: OldIndex -> OldIndex -> OldIndex
$cmin :: OldIndex -> OldIndex -> OldIndex
min :: OldIndex -> OldIndex -> OldIndex
Ord, Num OldIndex
Ord OldIndex
(Num OldIndex, Ord OldIndex) =>
(OldIndex -> Rational) -> Real OldIndex
OldIndex -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: OldIndex -> Rational
toRational :: OldIndex -> Rational
Real, Enum OldIndex
Real OldIndex
(Real OldIndex, Enum OldIndex) =>
(OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex -> OldIndex)
-> (OldIndex -> OldIndex -> (OldIndex, OldIndex))
-> (OldIndex -> OldIndex -> (OldIndex, OldIndex))
-> (OldIndex -> Integer)
-> Integral OldIndex
OldIndex -> Integer
OldIndex -> OldIndex -> (OldIndex, OldIndex)
OldIndex -> OldIndex -> OldIndex
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: OldIndex -> OldIndex -> OldIndex
quot :: OldIndex -> OldIndex -> OldIndex
$crem :: OldIndex -> OldIndex -> OldIndex
rem :: OldIndex -> OldIndex -> OldIndex
$cdiv :: OldIndex -> OldIndex -> OldIndex
div :: OldIndex -> OldIndex -> OldIndex
$cmod :: OldIndex -> OldIndex -> OldIndex
mod :: OldIndex -> OldIndex -> OldIndex
$cquotRem :: OldIndex -> OldIndex -> (OldIndex, OldIndex)
quotRem :: OldIndex -> OldIndex -> (OldIndex, OldIndex)
$cdivMod :: OldIndex -> OldIndex -> (OldIndex, OldIndex)
divMod :: OldIndex -> OldIndex -> (OldIndex, OldIndex)
$ctoInteger :: OldIndex -> Integer
toInteger :: OldIndex -> Integer
Integral, OldIndex -> OldIndex -> Bool
(OldIndex -> OldIndex -> Bool)
-> (OldIndex -> OldIndex -> Bool) -> Eq OldIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OldIndex -> OldIndex -> Bool
== :: OldIndex -> OldIndex -> Bool
$c/= :: OldIndex -> OldIndex -> Bool
/= :: OldIndex -> OldIndex -> Bool
Eq)

instance Flat OldIndex where
    -- encode from word64 to natural
    encode :: OldIndex -> Encoding
encode = forall a. Flat a => a -> Encoding
encode @Natural (Natural -> Encoding)
-> (OldIndex -> Natural) -> OldIndex -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OldIndex -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    -- decode from natural to word64
    decode :: Get OldIndex
decode = do
        Natural
n <- forall a. Flat a => Get a
decode @Natural
        case Natural -> Maybe Word64
naturalToWord64Maybe Natural
n of
            Maybe Word64
Nothing  -> TestName -> Get OldIndex
forall a. TestName -> Get a
forall (m :: * -> *) a. MonadFail m => TestName -> m a
fail (TestName -> Get OldIndex) -> TestName -> Get OldIndex
forall a b. (a -> b) -> a -> b
$ TestName
"Index outside representable range: " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ Natural -> TestName
forall a. Show a => a -> TestName
show Natural
n
            Just Word64
w64 -> OldIndex -> Get OldIndex
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OldIndex -> Get OldIndex) -> OldIndex -> Get OldIndex
forall a b. (a -> b) -> a -> b
$ Word64 -> OldIndex
OldIndex Word64
w64
    -- to be exact, we must not let this be generically derived,
    -- because the `gsize` would derive the size of the underlying Word64,
    -- whereas we want the size of Natural
    size :: OldIndex -> Int -> Int
size = Size Natural
sNatural Size Natural -> (OldIndex -> Natural) -> OldIndex -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OldIndex -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- * helpers

minWord64AsNat :: Natural
minWord64AsNat :: Natural
minWord64AsNat = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Natural Word64
forall a. Bounded a => a
minBound

maxWord64AsNat :: Natural
maxWord64AsNat :: Natural
maxWord64AsNat = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Natural Word64
forall a. Bounded a => a
maxBound