{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Constrained.Classes where

import Cardano.Ledger.Alonzo.Scripts (AsIx, AsIxItem, PlutusPurpose)
import Cardano.Ledger.Alonzo.TxOut (AlonzoTxOut (..))
import Cardano.Ledger.Babbage.TxOut (BabbageTxOut (..))
import Cardano.Ledger.BaseTypes (EpochNo (..), ProtVer (..), SlotNo (..))
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
import Cardano.Ledger.Conway.Governance hiding (GovState)
import Cardano.Ledger.Core
import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..))
import Cardano.Ledger.Plutus (ExUnits (..))
import Cardano.Ledger.Shelley.Governance (FuturePParams (..), ShelleyGovState (..))
import qualified Cardano.Ledger.Shelley.Governance as Gov
import Cardano.Ledger.Shelley.PParams (pvCanFollow)
import qualified Cardano.Ledger.Shelley.PParams as PP (ProposedPPUpdates (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.State (EraCertState (..), IndividualPoolStake (..), ScriptsNeeded, UTxO (..))
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Ledger.Val (Val (coin, modifyCoin, (<+>)))
import Data.Default (Default (def))
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable
import Data.Word (Word64)
import GHC.Real (denominator, numerator, (%))
import Lens.Micro
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Babbage.Arbitrary ()
import Test.Cardano.Ledger.Constrained.Combinators (errorMess)
import Test.Cardano.Ledger.Constrained.Monad (
  LiftT (..),
  Typed (..),
  failT,
 )
import Test.Cardano.Ledger.Constrained.Pairing (pair, unpair)
import Test.Cardano.Ledger.Constrained.Scripts (genCoreScript)
import Test.Cardano.Ledger.Constrained.Size (
  Size (..),
  genFromIntRange,
  genFromNonNegIntRange,
  genFromSize,
  negateSize,
  sepsP,
 )
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Generic.Functions (protocolVersion)
import Test.Cardano.Ledger.Generic.GenState (plutusPurposeTags)
import Test.Cardano.Ledger.Generic.PrettyCore (
  PDoc,
  PrettyA (..),
  pcCertState,
  pcPParams,
  pcScript,
  pcScriptsNeeded,
  pcTx,
  pcTxBody,
  pcTxCert,
  pcTxOut,
  pcVal,
  pcWitnesses,
  ppPlutusPurposeAsIx,
  ppPlutusPurposeAsIxItem,
  ppProposedPPUpdates,
  ppString,
 )
import Test.Cardano.Ledger.Generic.Proof (
  Proof (..),
  Reflect (..),
  unReflect,
 )
import Test.Cardano.Ledger.Shelley.Constants (defaultConstants)
import Test.Cardano.Ledger.Shelley.Generator.Update (genShelleyPParamsUpdate)
import Test.QuickCheck (
  Arbitrary (..),
  Gen,
  choose,
  chooseInt,
  elements,
  frequency,
  oneof,
  shuffle,
  suchThat,
  vectorOf,
 )

-- =====================================================================
-- Helper functions

gauss :: Floating a => a -> a -> a -> a
gauss :: forall a. Floating a => a -> a -> a -> a
gauss a
mean a
stdev a
x = (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
stdev a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
sqrt (a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Floating a => a
pi))) a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
exp (a -> a
forall a. Num a => a -> a
negate ((a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2) a -> a -> a
forall a. Num a => a -> a -> a
* ((a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
mean) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
stdev) a -> a -> a
forall a. Floating a => a -> a -> a
** a
2))

-- | The Adds class
--
-- Some methods of 'Adds' like 'minus', 'genAdds', 'partition' and 'fromI' are partial.
-- That is they might not be defined on all inputs. The `[string]` is a representation
-- of a stack trace, that describes what the sytem was doing, so if the function is partial
-- it can raise an appropriate error. The function
-- Test.Cardano.Ledger.Constrained.Combinators(errorMess) is used to raise an error
-- and properly report the stack trace.
class (Eq x, Show x, Typeable x) => Adds x where
  -- | Additive identity
  zero :: x

  -- | Just the unit of increment.
  one :: x

  -- | Add two of these
  add :: x -> x -> x

  -- | Subtract one from another
  minus :: [String] -> x -> x -> x

  -- | Increase by unit of increment
  increaseBy1 :: Int -> Int
  increaseBy1 Int
n = Int -> Int -> Int
forall x. Adds x => x -> x -> x
add Int
n Int
forall x. Adds x => x
one

  -- | Decrease by unit of increment
  decreaseBy1 :: Int -> Int
  decreaseBy1 Int
n = [String] -> Int -> Int -> Int
forall x. Adds x => [String] -> x -> x -> x
minus [String
"decreaseBy1"] Int
n Int
forall x. Adds x => x
one

  -- | Generate a list of values
  -- @ partition 7 trace 4 235 @ generate a list of length 4 that
  -- adds up t0 235, where the smallest number is >= 7
  partition :: x -> [String] -> Int -> x -> Gen [x]

  -- | Generate a single value
  -- @ genAdds trace spec @ generates an 'x' in the range specified by 'spec'
  genAdds :: [String] -> AddsSpec x -> Gen x

  -- | Analogous to fromIntegral, translate an Int to an appropriate 'x'
  fromI :: [String] -> Int -> x

  -- | translate an 'x' Int to an appropriate Int
  toI :: x -> Int

  -- | Used in testing to get appropriate 'smallest' values to test
  -- 'partition smallest trace count total'. The generator should choose from
  -- several values appropriate for the type 'x'. choose [0,1,2] would be
  -- appropriate for Natural, since there are no negative Natural numbers.
  genSmall :: Gen Int

  runOrdCondition :: OrdCond -> x -> x -> Bool

  supportsNegative :: x -> Bool

  smallerOf :: x -> x -> x

sumAdds :: (Foldable t, Adds c) => t c -> c
sumAdds :: forall (t :: * -> *) c. (Foldable t, Adds c) => t c -> c
sumAdds = (c -> c -> c) -> c -> t c -> c
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' c -> c -> c
forall x. Adds x => x -> x -> x
add c
forall x. Adds x => x
zero

lensAdds :: (Foldable t, Adds b) => Lens' a b -> t a -> b
lensAdds :: forall (t :: * -> *) b a.
(Foldable t, Adds b) =>
Lens' a b -> t a -> b
lensAdds Lens' a b
l = (b -> a -> b) -> b -> t a -> b
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' b -> a -> b
accum b
forall x. Adds x => x
zero
  where
    accum :: b -> a -> b
accum b
ans a
x = b -> b -> b
forall x. Adds x => x -> x -> x
add b
ans (a
x a -> Getting b a b -> b
forall s a. s -> Getting a s a -> a
^. Getting b a b
Lens' a b
l)

genFromAddsSpec :: [String] -> AddsSpec c -> Gen Int
genFromAddsSpec :: forall c. [String] -> AddsSpec c -> Gen Int
genFromAddsSpec [String]
_ AddsSpec c
AddsSpecAny = Size -> Gen Int
genFromIntRange Size
SzAny
genFromAddsSpec [String]
_ (AddsSpecSize String
_ Size
size) = Size -> Gen Int
genFromIntRange Size
size
genFromAddsSpec [String]
msgs (AddsSpecNever [String]
_) = String -> [String] -> Gen Int
forall a. HasCallStack => String -> [String] -> a
errorMess String
"genFromAddsSpec applied to AddsSpecNever" [String]
msgs

genFromNonNegAddsSpec :: [String] -> AddsSpec c -> Gen Int
genFromNonNegAddsSpec :: forall c. [String] -> AddsSpec c -> Gen Int
genFromNonNegAddsSpec [String]
_ AddsSpec c
AddsSpecAny = Size -> Gen Int
genFromNonNegIntRange Size
SzAny
genFromNonNegAddsSpec [String]
_ (AddsSpecSize String
_ Size
size) = Size -> Gen Int
genFromNonNegIntRange Size
size
genFromNonNegAddsSpec [String]
msgs (AddsSpecNever [String]
_) = String -> [String] -> Gen Int
forall a. HasCallStack => String -> [String] -> a
errorMess String
"genFromAddsSpec applied to AddsSpecNever" [String]
msgs

-- ================
-- Adds instances

instance Adds ExUnits where
  zero :: ExUnits
zero = Natural -> Natural -> ExUnits
ExUnits Natural
0 Natural
0
  one :: ExUnits
one = Natural -> Natural -> ExUnits
ExUnits Natural
1 Natural
1
  add :: ExUnits -> ExUnits -> ExUnits
add (ExUnits Natural
a Natural
b) (ExUnits Natural
c Natural
d) = Natural -> Natural -> ExUnits
ExUnits (Natural
a Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
c) (Natural
b Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
d)
  minus :: [String] -> ExUnits -> ExUnits -> ExUnits
minus [String]
msgs (ExUnits Natural
a Natural
b) (ExUnits Natural
c Natural
d) =
    Natural -> Natural -> ExUnits
ExUnits
      ([String] -> Natural -> Natural -> Natural
forall x. Adds x => [String] -> x -> x -> x
minus (String
"Ex memory" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Natural
a Natural
c)
      ([String] -> Natural -> Natural -> Natural
forall x. Adds x => [String] -> x -> x -> x
minus (String
"Ex steps" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Natural
b Natural
d)
  increaseBy1 :: Int -> Int
increaseBy1 Int
n = let (Int
i, Int
j) = Int -> (Int, Int)
unpair Int
n in Int -> Int -> Int
pair (forall x. Adds x => Int -> Int
increaseBy1 @Natural Int
i) (forall x. Adds x => Int -> Int
increaseBy1 @Natural Int
j)
  decreaseBy1 :: Int -> Int
decreaseBy1 Int
n = let (Int
i, Int
j) = Int -> (Int, Int)
unpair Int
n in Int -> Int -> Int
pair (forall x. Adds x => Int -> Int
decreaseBy1 @Natural Int
i) (forall x. Adds x => Int -> Int
decreaseBy1 @Natural Int
j)
  partition :: ExUnits -> [String] -> Int -> ExUnits -> Gen [ExUnits]
partition (ExUnits Natural
smallestmemory Natural
smalleststeps) [String]
msgs Int
count (ExUnits Natural
memory Natural
steps) = do
    [Natural]
memG <- Natural -> [String] -> Int -> Natural -> Gen [Natural]
forall x. Adds x => x -> [String] -> Int -> x -> Gen [x]
partition Natural
smallestmemory (String
"Ex memory" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Int
count Natural
memory
    [Natural]
stepsG <- Natural -> [String] -> Int -> Natural -> Gen [Natural]
forall x. Adds x => x -> [String] -> Int -> x -> Gen [x]
partition Natural
smalleststeps (String
"Ex steps" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Int
count Natural
steps
    [ExUnits] -> Gen [ExUnits]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Natural -> Natural -> ExUnits)
-> [Natural] -> [Natural] -> [ExUnits]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Natural -> Natural -> ExUnits
ExUnits [Natural]
memG [Natural]
stepsG)
  genAdds :: [String] -> AddsSpec ExUnits -> Gen ExUnits
genAdds [String]
msgs = \case
    AddsSpec ExUnits
AddsSpecAny -> String -> [String] -> Gen ExUnits
forall a. HasCallStack => String -> [String] -> a
errorMess String
"AddsSpecAny" [String]
ms
    AddsSpecNever [String]
msgs' -> String -> [String] -> Gen ExUnits
forall a. HasCallStack => String -> [String] -> a
errorMess String
"AddsSpecNever" ([String] -> Gen ExUnits) -> [String] -> Gen ExUnits
forall a b. (a -> b) -> a -> b
$ [String]
ms [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
msgs'
    AddsSpecSize String
msg Size
sz -> case Size
sz of
      SzLeast Int
n ->
        let (Int
i, Int
j) = Int -> (Int, Int)
unpair Int
n
         in do
              Natural
ig <- Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Gen Int -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Gen Int
genFromSize (Int -> Size
SzLeast Int
i)
              Natural
jg <- Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Gen Int -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Gen Int
genFromSize (Int -> Size
SzLeast Int
j)
              ExUnits -> Gen ExUnits
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExUnits -> Gen ExUnits) -> ExUnits -> Gen ExUnits
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
ig Natural
jg
      SzMost Int
n ->
        let (Int
i, Int
j) = Int -> (Int, Int)
unpair Int
n
         in do
              Natural
ig <- Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Gen Int -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Gen Int
genFromSize (Int -> Size
SzMost Int
i)
              Natural
jg <- Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Gen Int -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Gen Int
genFromSize (Int -> Size
SzMost Int
j)
              ExUnits -> Gen ExUnits
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExUnits -> Gen ExUnits) -> ExUnits -> Gen ExUnits
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
ig Natural
jg
      SzExact Int
n ->
        let (Int
i, Int
j) = Int -> (Int, Int)
unpair Int
n
         in do
              Natural
ig <- Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Gen Int -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Gen Int
genFromSize (Int -> Size
SzExact Int
i)
              Natural
jg <- Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Gen Int -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Gen Int
genFromSize (Int -> Size
SzExact Int
j)
              ExUnits -> Gen ExUnits
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExUnits -> Gen ExUnits) -> ExUnits -> Gen ExUnits
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
ig Natural
jg
      SzNever [String]
m -> String -> [String] -> Gen ExUnits
forall a. HasCallStack => String -> [String] -> a
errorMess String
"AddsSpecSize SzNever" ([String] -> Gen ExUnits) -> [String] -> Gen ExUnits
forall a b. (a -> b) -> a -> b
$ [String]
ms [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
msg] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
m
      Size
_ -> String -> [String] -> Gen ExUnits
forall a. HasCallStack => String -> [String] -> a
errorMess String
"AddsSpecSize SzAny or SzRng" ([String] -> Gen ExUnits) -> [String] -> Gen ExUnits
forall a b. (a -> b) -> a -> b
$ [String]
ms [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
msg]
    where
      ms :: [String]
ms = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"genAdds ExUnits"]
  fromI :: [String] -> Int -> ExUnits
fromI [String]
msgs Int
n = Natural -> Natural -> ExUnits
ExUnits Natural
mem Natural
step
    where
      (Int
memInt, Int
stepInt) = Int -> (Int, Int)
unpair Int
n
      mem :: Natural
mem = [String] -> Int -> Natural
forall x. Adds x => [String] -> Int -> x
fromI (String
"Ex memory" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Int
memInt
      step :: Natural
step = [String] -> Int -> Natural
forall x. Adds x => [String] -> Int -> x
fromI (String
"Ex steps" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Int
stepInt
  toI :: ExUnits -> Int
toI (ExUnits Natural
mem Natural
step) = Int -> Int -> Int
pair (Natural -> Int
forall x. Adds x => x -> Int
toI Natural
mem) (Natural -> Int
forall x. Adds x => x -> Int
toI Natural
step)
  supportsNegative :: ExUnits -> Bool
supportsNegative ExUnits
_ = Bool
False
  genSmall :: Gen Int
genSmall = [Gen Int] -> Gen Int
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Gen Int) -> Int -> Gen Int
forall a b. (a -> b) -> a -> b
$ ExUnits -> Int
forall x. Adds x => x -> Int
toI (Natural -> Natural -> ExUnits
ExUnits Natural
1 Natural
1), Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Gen Int) -> Int -> Gen Int
forall a b. (a -> b) -> a -> b
$ ExUnits -> Int
forall x. Adds x => x -> Int
toI (Natural -> Natural -> ExUnits
ExUnits Natural
2 Natural
2), Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Gen Int) -> Int -> Gen Int
forall a b. (a -> b) -> a -> b
$ ExUnits -> Int
forall x. Adds x => x -> Int
toI (Natural -> Natural -> ExUnits
ExUnits Natural
3 Natural
1)]

  -- Some ExUnits are incomparable: i.e. x=(ExUnits 5 7) and y=(ExUnits 8 3)
  -- neither x<y  or y<x is true.
  runOrdCondition :: OrdCond -> ExUnits -> ExUnits -> Bool
runOrdCondition OrdCond
EQL (ExUnits Natural
a Natural
b) (ExUnits Natural
c Natural
d) = Natural
a Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
c Bool -> Bool -> Bool
&& Natural
b Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
d
  runOrdCondition OrdCond
LTH (ExUnits Natural
a Natural
b) (ExUnits Natural
c Natural
d) = Natural
a Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
c Bool -> Bool -> Bool
&& Natural
b Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
d
  runOrdCondition OrdCond
LTE (ExUnits Natural
a Natural
b) (ExUnits Natural
m Natural
n) = OrdCond -> Natural -> Natural -> Bool
forall x. Adds x => OrdCond -> x -> x -> Bool
runOrdCondition OrdCond
LTE Natural
a Natural
m Bool -> Bool -> Bool
&& OrdCond -> Natural -> Natural -> Bool
forall x. Adds x => OrdCond -> x -> x -> Bool
runOrdCondition OrdCond
LTE Natural
b Natural
n
  runOrdCondition OrdCond
GTH (ExUnits Natural
a Natural
b) (ExUnits Natural
c Natural
d) = Natural
a Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
c Bool -> Bool -> Bool
&& Natural
b Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
d
  runOrdCondition OrdCond
GTE (ExUnits Natural
a Natural
b) (ExUnits Natural
m Natural
n) = OrdCond -> Natural -> Natural -> Bool
forall x. Adds x => OrdCond -> x -> x -> Bool
runOrdCondition OrdCond
GTE Natural
a Natural
m Bool -> Bool -> Bool
&& OrdCond -> Natural -> Natural -> Bool
forall x. Adds x => OrdCond -> x -> x -> Bool
runOrdCondition OrdCond
GTE Natural
b Natural
n
  smallerOf :: ExUnits -> ExUnits -> ExUnits
smallerOf ExUnits
x ExUnits
y
    | OrdCond -> ExUnits -> ExUnits -> Bool
forall x. Adds x => OrdCond -> x -> x -> Bool
runOrdCondition OrdCond
LTE ExUnits
x ExUnits
y = ExUnits
x
    | OrdCond -> ExUnits -> ExUnits -> Bool
forall x. Adds x => OrdCond -> x -> x -> Bool
runOrdCondition OrdCond
GTE ExUnits
x ExUnits
y = ExUnits
y
    | Bool
otherwise = String -> [String] -> ExUnits
forall a. HasCallStack => String -> [String] -> a
errorMess String
"ExUnits are incomparable, can't choose the 'smallerOf'" [ExUnits -> String
forall a. Show a => a -> String
show ExUnits
x, ExUnits -> String
forall a. Show a => a -> String
show ExUnits
y]

-- ================
instance Adds Word64 where
  zero :: Word64
zero = Word64
0
  one :: Word64
one = Word64
1
  add :: Word64 -> Word64 -> Word64
add = Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+)
  minus :: [String] -> Word64 -> Word64 -> Word64
minus [String]
msg Word64
x Word64
y =
    if Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
y
      then String -> [String] -> Word64
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"(minus @Word64 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") is not possible") [String]
msg
      else Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
y
  partition :: Word64 -> [String] -> Int -> Word64 -> Gen [Word64]
partition = Word64 -> [String] -> Int -> Word64 -> Gen [Word64]
partitionWord64
  genAdds :: [String] -> AddsSpec Word64 -> Gen Word64
genAdds [String]
msgs AddsSpec Word64
spec = [String] -> Int -> Word64
forall x. Adds x => [String] -> Int -> x
fromI [String]
ms (Int -> Word64) -> Gen Int -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> AddsSpec Word64 -> Gen Int
forall c. [String] -> AddsSpec c -> Gen Int
genFromNonNegAddsSpec [String]
ms AddsSpec Word64
spec
    where
      ms :: [String]
ms = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"genAdds Word64"]
  fromI :: [String] -> Int -> Word64
fromI [String]
_ Int
m | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
  fromI [String]
msgs Int
m = String -> [String] -> Word64
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"can't convert " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into a Word64.") [String]
msgs
  toI :: Word64 -> Int
toI = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  genSmall :: Gen Int
genSmall = [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
0, Int
1, Int
2]
  runOrdCondition :: OrdCond -> Word64 -> Word64 -> Bool
runOrdCondition = OrdCond -> Word64 -> Word64 -> Bool
forall c. Ord c => OrdCond -> c -> c -> Bool
runOrdCond
  supportsNegative :: Word64 -> Bool
supportsNegative Word64
_ = Bool
False
  smallerOf :: Word64 -> Word64 -> Word64
smallerOf = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min

instance Adds Int where
  zero :: Int
zero = Int
0
  one :: Int
one = Int
1
  add :: Int -> Int -> Int
add = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
  minus :: [String] -> Int -> Int -> Int
minus [String]
_ = (-)
  partition :: Int -> [String] -> Int -> Int -> Gen [Int]
partition = Int -> [String] -> Int -> Int -> Gen [Int]
partitionInt
  genAdds :: [String] -> AddsSpec Int -> Gen Int
genAdds [String]
msgs AddsSpec Int
spec = [String] -> Int -> Int
forall x. Adds x => [String] -> Int -> x
fromI [String]
ms (Int -> Int) -> Gen Int -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> AddsSpec Int -> Gen Int
forall c. [String] -> AddsSpec c -> Gen Int
genFromAddsSpec [String]
ms AddsSpec Int
spec
    where
      ms :: [String]
ms = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"genAdds Int"]
  fromI :: [String] -> Int -> Int
fromI [String]
_ Int
n = Int
n
  toI :: Int -> Int
toI Int
n = Int
n
  genSmall :: Gen Int
genSmall = [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [-Int
2, -Int
1, Int
0, Int
1, Int
2]
  runOrdCondition :: OrdCond -> Int -> Int -> Bool
runOrdCondition = OrdCond -> Int -> Int -> Bool
forall c. Ord c => OrdCond -> c -> c -> Bool
runOrdCond
  supportsNegative :: Int -> Bool
supportsNegative Int
_ = Bool
True
  smallerOf :: Int -> Int -> Int
smallerOf = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min

instance Adds Natural where
  zero :: Natural
zero = Natural
0
  one :: Natural
one = Natural
1
  add :: Natural -> Natural -> Natural
add = Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+)
  minus :: [String] -> Natural -> Natural -> Natural
minus [String]
msg Natural
x Natural
y =
    if Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
y
      then String -> [String] -> Natural
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"(minus @Natural " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Natural -> String
forall a. Show a => a -> String
show Natural
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") is not possible") [String]
msg
      else Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
y
  partition :: Natural -> [String] -> Int -> Natural -> Gen [Natural]
partition = Natural -> [String] -> Int -> Natural -> Gen [Natural]
partitionNatural
  genAdds :: [String] -> AddsSpec Natural -> Gen Natural
genAdds [String]
msgs AddsSpec Natural
spec = [String] -> Int -> Natural
forall x. Adds x => [String] -> Int -> x
fromI [String]
ms (Int -> Natural) -> Gen Int -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> AddsSpec Natural -> Gen Int
forall c. [String] -> AddsSpec c -> Gen Int
genFromNonNegAddsSpec [String]
ms AddsSpec Natural
spec
    where
      ms :: [String]
ms = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"genAdds Natural"]
  fromI :: [String] -> Int -> Natural
fromI [String]
_ Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
  fromI [String]
msgs Int
m = String -> [String] -> Natural
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"can't convert " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into a Natural.") [String]
msgs
  toI :: Natural -> Int
toI = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  genSmall :: Gen Int
genSmall = [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
0, Int
1, Int
2]
  runOrdCondition :: OrdCond -> Natural -> Natural -> Bool
runOrdCondition = OrdCond -> Natural -> Natural -> Bool
forall c. Ord c => OrdCond -> c -> c -> Bool
runOrdCond
  supportsNegative :: Natural -> Bool
supportsNegative Natural
_ = Bool
False
  smallerOf :: Natural -> Natural -> Natural
smallerOf = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
min

instance Adds Rational where
  zero :: Ratio Integer
zero = Ratio Integer
0
  one :: Ratio Integer
one = Ratio Integer
1
  add :: Ratio Integer -> Ratio Integer -> Ratio Integer
add = Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
(+)
  minus :: [String] -> Ratio Integer -> Ratio Integer -> Ratio Integer
minus [String]
_ = (-)
  partition :: Ratio Integer
-> [String] -> Int -> Ratio Integer -> Gen [Ratio Integer]
partition = Ratio Integer
-> [String] -> Int -> Ratio Integer -> Gen [Ratio Integer]
partitionRational
  genAdds :: [String] -> AddsSpec (Ratio Integer) -> Gen (Ratio Integer)
genAdds [String]
msgs AddsSpec (Ratio Integer)
spec = [String] -> Int -> Ratio Integer
forall x. Adds x => [String] -> Int -> x
fromI [String]
ms (Int -> Ratio Integer) -> Gen Int -> Gen (Ratio Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> AddsSpec (Ratio Integer) -> Gen Int
forall c. [String] -> AddsSpec c -> Gen Int
genFromAddsSpec [String]
ms AddsSpec (Ratio Integer)
spec
    where
      ms :: [String]
ms = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"genAdds Rational"]
  fromI :: [String] -> Int -> Ratio Integer
fromI [String]
_ Int
n = (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000) Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1
  toI :: Ratio Integer -> Int
toI Ratio Integer
r = Ratio Integer -> Int
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Ratio Integer
r Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
1000)
  genSmall :: Gen Int
genSmall = [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
0, Int
1]
  runOrdCondition :: OrdCond -> Ratio Integer -> Ratio Integer -> Bool
runOrdCondition = OrdCond -> Ratio Integer -> Ratio Integer -> Bool
forall c. Ord c => OrdCond -> c -> c -> Bool
runOrdCond
  supportsNegative :: Ratio Integer -> Bool
supportsNegative Ratio Integer
_ = Bool
True
  smallerOf :: Ratio Integer -> Ratio Integer -> Ratio Integer
smallerOf = Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Ord a => a -> a -> a
min

instance Adds Coin where
  zero :: Coin
zero = Integer -> Coin
Coin Integer
0
  one :: Coin
one = Integer -> Coin
Coin Integer
1
  add :: Coin -> Coin -> Coin
add = Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
(<+>)
  minus :: [String] -> Coin -> Coin -> Coin
minus [String]
msg (Coin Integer
n) (Coin Integer
m) =
    if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
m
      then String -> [String] -> Coin
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"(minus @Coin " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") is not possible") [String]
msg
      else Integer -> Coin
Coin (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
m)
  partition :: Coin -> [String] -> Int -> Coin -> Gen [Coin]
partition = Coin -> [String] -> Int -> Coin -> Gen [Coin]
partitionCoin
  genAdds :: [String] -> AddsSpec Coin -> Gen Coin
genAdds [String]
msgs AddsSpec Coin
spec = [String] -> Int -> Coin
forall x. Adds x => [String] -> Int -> x
fromI [String]
ms (Int -> Coin) -> Gen Int -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> AddsSpec Coin -> Gen Int
forall c. [String] -> AddsSpec c -> Gen Int
genFromNonNegAddsSpec [String]
ms AddsSpec Coin
spec
    where
      ms :: [String]
ms = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"genAdds Coin"]
  fromI :: [String] -> Int -> Coin
fromI [String]
_ Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Integer -> Coin
Coin (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  fromI [String]
msgs Int
m = String -> [String] -> Coin
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"can't convert " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into a Coin.") [String]
msgs
  toI :: Coin -> Int
toI (Coin Integer
n) = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
  genSmall :: Gen Int
genSmall = [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
0, Int
1, Int
2]
  runOrdCondition :: OrdCond -> Coin -> Coin -> Bool
runOrdCondition = OrdCond -> Coin -> Coin -> Bool
forall c. Ord c => OrdCond -> c -> c -> Bool
runOrdCond
  supportsNegative :: Coin -> Bool
supportsNegative Coin
_ = Bool
False
  smallerOf :: Coin -> Coin -> Coin
smallerOf = Coin -> Coin -> Coin
forall a. Ord a => a -> a -> a
min

instance Adds DeltaCoin where
  zero :: DeltaCoin
zero = Integer -> DeltaCoin
DeltaCoin Integer
0
  one :: DeltaCoin
one = Integer -> DeltaCoin
DeltaCoin Integer
1
  add :: DeltaCoin -> DeltaCoin -> DeltaCoin
add = DeltaCoin -> DeltaCoin -> DeltaCoin
forall t. Val t => t -> t -> t
(<+>)
  minus :: [String] -> DeltaCoin -> DeltaCoin -> DeltaCoin
minus [String]
_ (DeltaCoin Integer
n) (DeltaCoin Integer
m) = Integer -> DeltaCoin
DeltaCoin (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
m)
  partition :: DeltaCoin -> [String] -> Int -> DeltaCoin -> Gen [DeltaCoin]
partition = DeltaCoin -> [String] -> Int -> DeltaCoin -> Gen [DeltaCoin]
partitionDeltaCoin
  genAdds :: [String] -> AddsSpec DeltaCoin -> Gen DeltaCoin
genAdds [String]
msgs AddsSpec DeltaCoin
spec = [String] -> Int -> DeltaCoin
forall x. Adds x => [String] -> Int -> x
fromI [String]
ms (Int -> DeltaCoin) -> Gen Int -> Gen DeltaCoin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> AddsSpec DeltaCoin -> Gen Int
forall c. [String] -> AddsSpec c -> Gen Int
genFromAddsSpec [String]
ms AddsSpec DeltaCoin
spec
    where
      ms :: [String]
ms = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"genAdds DeltaCoin"]
  fromI :: [String] -> Int -> DeltaCoin
fromI [String]
_ Int
n = Integer -> DeltaCoin
DeltaCoin (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  toI :: DeltaCoin -> Int
toI (DeltaCoin Integer
n) = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
  genSmall :: Gen Int
genSmall = [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [-Int
2, Int
0, Int
1, Int
2]
  runOrdCondition :: OrdCond -> DeltaCoin -> DeltaCoin -> Bool
runOrdCondition = OrdCond -> DeltaCoin -> DeltaCoin -> Bool
forall c. Ord c => OrdCond -> c -> c -> Bool
runOrdCond
  supportsNegative :: DeltaCoin -> Bool
supportsNegative DeltaCoin
_ = Bool
True
  smallerOf :: DeltaCoin -> DeltaCoin -> DeltaCoin
smallerOf = DeltaCoin -> DeltaCoin -> DeltaCoin
forall a. Ord a => a -> a -> a
min

-- ===========================================================================
-- The Sums class, for summing a projected c (where Adds c) from some richer type

class (Show x, Adds x) => Sums t x | t -> x where
  getSum :: t -> x
  genT :: [String] -> x -> Gen t

instance Sums IndividualPoolStake Rational where
  getSum :: IndividualPoolStake -> Ratio Integer
getSum (IndividualPoolStake Ratio Integer
r CompactForm Coin
_ VRFVerKeyHash 'StakePoolVRF
_) = Ratio Integer
r
  genT :: [String] -> Ratio Integer -> Gen IndividualPoolStake
genT [String]
_ Ratio Integer
r =
    -- We use mempty for the individualTotalPoolStake here
    -- but that field is intended to hold the total stake
    -- assigned to the pool. We do not have enough information
    -- here to be able to assign it its correct value.
    Ratio Integer
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake Ratio Integer
r CompactForm Coin
forall a. Monoid a => a
mempty (VRFVerKeyHash 'StakePoolVRF -> IndividualPoolStake)
-> Gen (VRFVerKeyHash 'StakePoolVRF) -> Gen IndividualPoolStake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VRFVerKeyHash 'StakePoolVRF)
forall a. Arbitrary a => Gen a
arbitrary

instance Reflect era => Sums (TxOutF era) Coin where
  getSum :: TxOutF era -> Coin
getSum (TxOutF Proof era
_ TxOut era
txout) = Value era -> Coin
forall t. Val t => t -> Coin
coin (TxOut era
txout TxOut era
-> Getting (Value era) (TxOut era) (Value era) -> Value era
forall s a. s -> Getting a s a -> a
^. Getting (Value era) (TxOut era) (Value era)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL)
  genT :: [String] -> Coin -> Gen (TxOutF era)
genT [String]
_ Coin
cn = Proof era -> Coin -> Gen (TxOutF era)
forall era. Reflect era => Proof era -> Coin -> Gen (TxOutF era)
genTxOutX Proof era
forall era. Reflect era => Proof era
reify Coin
cn

genTxOutX :: Reflect era => Proof era -> Coin -> Gen (TxOutF era)
genTxOutX :: forall era. Reflect era => Proof era -> Coin -> Gen (TxOutF era)
genTxOutX Proof era
p Coin
coins = do
  TxOut era
txout <- case Proof era
p of
    Proof era
Shelley -> Gen (TxOut era)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Allegra -> Gen (TxOut era)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Mary -> Gen (TxOut era)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Alonzo -> Gen (TxOut era)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Babbage -> Gen (TxOut era)
forall a. Arbitrary a => Gen a
arbitrary
    Proof era
Conway -> Gen (TxOut era)
forall a. Arbitrary a => Gen a
arbitrary
  TxOutF era -> Gen (TxOutF era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutF era -> Gen (TxOutF era)) -> TxOutF era -> Gen (TxOutF era)
forall a b. (a -> b) -> a -> b
$ Proof era -> TxOut era -> TxOutF era
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p (TxOut era
txout TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
coins)

instance Reflect era => Sums (ValueF era) Coin where
  getSum :: ValueF era -> Coin
getSum (ValueF Proof era
_ Value era
v) = Value era -> Coin
forall t. Val t => t -> Coin
coin Value era
v
  genT :: [String] -> Coin -> Gen (ValueF era)
genT [String]
_ Coin
cn = Proof era -> Coin -> Gen (ValueF era)
forall era. Reflect era => Proof era -> Coin -> Gen (ValueF era)
genValueX Proof era
forall era. Reflect era => Proof era
reify Coin
cn

genValueX :: Reflect era => Proof era -> Coin -> Gen (ValueF era)
genValueX :: forall era. Reflect era => Proof era -> Coin -> Gen (ValueF era)
genValueX Proof era
proof Coin
cn = do
  ValueF Proof era
p Value era
v <- Proof era -> Gen (ValueF era)
forall era. Proof era -> Gen (ValueF era)
genValue Proof era
proof
  ValueF era -> Gen (ValueF era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> Value era -> ValueF era
forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p ((Coin -> Coin) -> Value era -> Value era
forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin (Coin -> Coin -> Coin
forall a b. a -> b -> a
const Coin
cn) Value era
v))

instance Sums [Reward] Coin where
  getSum :: [Reward] -> Coin
getSum [Reward]
ss = (Coin -> Reward -> Coin) -> Coin -> [Reward] -> Coin
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Coin -> Reward -> Coin
accum (Integer -> Coin
Coin Integer
0) [Reward]
ss
    where
      accum :: Coin -> Reward -> Coin
accum Coin
ans (Reward RewardType
_ KeyHash 'StakePool
_ Coin
c) = Coin -> Coin -> Coin
forall x. Adds x => x -> x -> x
add Coin
ans Coin
c
  genT :: [String] -> Coin -> Gen [Reward]
genT [String]
_ (Coin Integer
1) = (Reward -> [Reward] -> [Reward]
forall a. a -> [a] -> [a]
: []) (Reward -> [Reward]) -> Gen Reward -> Gen [Reward]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Coin -> Reward -> Reward
updateRew (Integer -> Coin
Coin Integer
1) (Reward -> Reward) -> Gen Reward -> Gen Reward
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Reward
forall a. Arbitrary a => Gen a
arbitrary)
  genT [String]
msgs (Coin Integer
n) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 = do
    Int
size <- (Int, Int) -> Gen Int
chooseInt (Int
1, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
    [Coin]
cs <- Coin -> [String] -> Int -> Coin -> Gen [Coin]
forall x. Adds x => x -> [String] -> Int -> x -> Gen [x]
partition (Integer -> Coin
Coin Integer
1) [String]
msgs Int
size (Integer -> Coin
Coin Integer
n)
    [Reward]
list <- Int -> Gen Reward -> Gen [Reward]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
size (Gen Reward
forall a. Arbitrary a => Gen a
arbitrary :: Gen Reward)
    [Reward] -> Gen [Reward]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Reward] -> Gen [Reward]) -> [Reward] -> Gen [Reward]
forall a b. (a -> b) -> a -> b
$ (Coin -> Reward -> Reward) -> [Coin] -> [Reward] -> [Reward]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Coin -> Reward -> Reward
updateRew [Coin]
cs [Reward]
list
  genT [String]
msgs Coin
c = String -> [String] -> Gen [Reward]
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"Coin in genT must be positive: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show Coin
c) [String]
msgs

updateRew :: Coin -> Reward -> Reward
updateRew :: Coin -> Reward -> Reward
updateRew Coin
c (Reward RewardType
a KeyHash 'StakePool
b Coin
_) = RewardType -> KeyHash 'StakePool -> Coin -> Reward
Reward RewardType
a KeyHash 'StakePool
b Coin
c

-- ===========================================================
-- Sizeable Class

class Show t => Sizeable t where
  -- | extract the 'size' of 't'
  getSize :: t -> Int

instance Sizeable Natural where
  getSize :: Natural -> Int
getSize Natural
n = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n

instance Sizeable Int where
  getSize :: Int -> Int
getSize Int
n = Int
n

instance Sizeable Word64 where
  getSize :: Word64 -> Int
getSize Word64
n = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

instance Sizeable EpochNo where
  getSize :: EpochNo -> Int
getSize (EpochNo Word64
n) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

instance Sizeable SlotNo where
  getSize :: SlotNo -> Int
getSize (SlotNo Word64
n) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

instance (Show dom, Show rng) => Sizeable (Map dom rng) where
  getSize :: Map dom rng -> Int
getSize Map dom rng
m = Map dom rng -> Int
forall k a. Map k a -> Int
Map.size Map dom rng
m

instance Show t => Sizeable (Set t) where
  getSize :: Set t -> Int
getSize Set t
m = Set t -> Int
forall a. Set a -> Int
Set.size Set t
m

instance Show t => Sizeable [t] where
  getSize :: [t] -> Int
getSize [t]
m = [t] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
m

instance Sizeable Coin where
  getSize :: Coin -> Int
getSize (Coin Integer
n) = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n

instance Sizeable MultiAsset where
  getSize :: MultiAsset -> Int
getSize (MultiAsset Map PolicyID (Map AssetName Integer)
m) = Map PolicyID (Map AssetName Integer) -> Int
forall k a. Map k a -> Int
Map.size Map PolicyID (Map AssetName Integer)
m

instance EraPParams era => Sizeable (Proposals era) where
  getSize :: Proposals era -> Int
getSize = Proposals era -> Int
forall era. Proposals era -> Int
proposalsSize

-- ===========================================================
-- The Count class 0,1,2,3,4 ...

class Count t where
  -- | 'canFollow x y', is 'x' an appropriate successor to 'y'
  canFollow :: t -> t -> Bool

  -- | Generate the predecessor, given the successor
  genPred :: t -> Gen t

  -- | Generate the successor, given the predecessor
  genSucc :: t -> Gen t

instance Count Int where
  canFollow :: Int -> Int -> Bool
canFollow Int
x Int
y = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y
  genPred :: Int -> Gen Int
genPred Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Gen Int
forall a. HasCallStack => String -> a
error (String
"genPredFromSucc @Int is undefined on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
  genPred Int
n = Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  genSucc :: Int -> Gen Int
genSucc Int
n = Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

instance Count ProtVer where
  canFollow :: ProtVer -> ProtVer -> Bool
canFollow ProtVer
succX ProtVer
predX = ProtVer -> ProtVer -> Bool
pvCanFollow ProtVer
predX ProtVer
succX
  genPred :: ProtVer -> Gen ProtVer
genPred succX :: ProtVer
succX@(ProtVer Version
n Natural
0)
    | Version
n Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
forall a. Bounded a => a
minBound = String -> Gen ProtVer
forall a. HasCallStack => String -> a
error (String
"genPredFromSucc @ProtVer is undefined on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProtVer -> String
forall a. Show a => a -> String
show ProtVer
succX)
  genPred (ProtVer Version
n Natural
0) = Version -> Natural -> ProtVer
ProtVer (Version -> Version
forall a. Enum a => a -> a
pred Version
n) (Natural -> ProtVer) -> Gen Natural -> Gen ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural] -> Gen Natural
forall a. HasCallStack => [a] -> Gen a
elements [Natural
0, Natural
1, Natural
2, Natural
3]
  genPred (ProtVer Version
n Natural
m) = ProtVer -> Gen ProtVer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Natural -> ProtVer
ProtVer Version
n (Natural
m Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
  genSucc :: ProtVer -> Gen ProtVer
genSucc (ProtVer Version
n Natural
m) = [(Int, Gen ProtVer)] -> Gen ProtVer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, ProtVer -> Gen ProtVer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Natural -> ProtVer
ProtVer (Version -> Version
forall a. Enum a => a -> a
succ Version
n) Natural
0)), (Int
2, ProtVer -> Gen ProtVer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Natural -> ProtVer
ProtVer Version
n (Natural
m Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1)))]

instance Count EpochNo where
  canFollow :: EpochNo -> EpochNo -> Bool
canFollow EpochNo
predX EpochNo
succX = EpochNo
predX EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
+ EpochNo
1 EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
== EpochNo
succX
  genPred :: EpochNo -> Gen EpochNo
genPred EpochNo
n | EpochNo
n EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
== EpochNo
0 = String -> Gen EpochNo
forall a. HasCallStack => String -> a
error (String
"genPredFromSucc @EpochNo is undefined on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EpochNo -> String
forall a. Show a => a -> String
show EpochNo
n)
  genPred EpochNo
n = EpochNo -> Gen EpochNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochNo
n EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
- EpochNo
1)
  genSucc :: EpochNo -> Gen EpochNo
genSucc EpochNo
n = EpochNo -> Gen EpochNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochNo
n EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
+ EpochNo
1)

instance Count SlotNo where
  canFollow :: SlotNo -> SlotNo -> Bool
canFollow SlotNo
predX SlotNo
succX = SlotNo
predX SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
1 SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== SlotNo
succX
  genPred :: SlotNo -> Gen SlotNo
genPred SlotNo
n | SlotNo
n SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== SlotNo
0 = String -> Gen SlotNo
forall a. HasCallStack => String -> a
error (String
"genPredFromSucc @SlotNo is undefined on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SlotNo -> String
forall a. Show a => a -> String
show SlotNo
n)
  genPred SlotNo
n = SlotNo -> Gen SlotNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
n SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
1)
  genSucc :: SlotNo -> Gen SlotNo
genSucc SlotNo
n = SlotNo -> Gen SlotNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
n SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
1)

-- ============================================================================
-- Special accomodation for Type Families
-- ============================================================================

data TxAuxDataF era where
  TxAuxDataF :: Proof era -> TxAuxData era -> TxAuxDataF era

hashTxAuxDataF :: Reflect era => TxAuxDataF era -> TxAuxDataHash
hashTxAuxDataF :: forall era. Reflect era => TxAuxDataF era -> TxAuxDataHash
hashTxAuxDataF (TxAuxDataF Proof era
_ TxAuxData era
x) = TxAuxData era -> TxAuxDataHash
forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
hashTxAuxData TxAuxData era
x

unTxAuxData :: TxAuxDataF era -> TxAuxData era
unTxAuxData :: forall era. TxAuxDataF era -> TxAuxData era
unTxAuxData (TxAuxDataF Proof era
_ TxAuxData era
x) = TxAuxData era
x

instance Show (TxAuxDataF era) where
  show :: TxAuxDataF era -> String
show (TxAuxDataF Proof era
p TxAuxData era
x) = PDoc -> String
forall a. Show a => a -> String
show (((Reflect era => Proof era -> TxAuxData era -> PDoc)
-> Proof era -> TxAuxData era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxAuxData era -> PDoc
Proof era -> TxAuxData era -> PDoc
forall era. Proof era -> TxAuxData era -> PDoc
pcAuxData Proof era
p TxAuxData era
x) :: PDoc)

instance Eq (TxAuxDataF era) where
  (TxAuxDataF Proof era
Shelley TxAuxData era
x) == :: TxAuxDataF era -> TxAuxDataF era -> Bool
== (TxAuxDataF Proof era
Shelley TxAuxData era
y) = TxAuxData era
ShelleyTxAuxData ShelleyEra
x ShelleyTxAuxData ShelleyEra -> ShelleyTxAuxData ShelleyEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxAuxData era
ShelleyTxAuxData ShelleyEra
y
  (TxAuxDataF Proof era
Allegra TxAuxData era
x) == (TxAuxDataF Proof era
Allegra TxAuxData era
y) = AllegraTxAuxData AllegraEra
TxAuxData era
x AllegraTxAuxData AllegraEra -> AllegraTxAuxData AllegraEra -> Bool
forall a. Eq a => a -> a -> Bool
== AllegraTxAuxData AllegraEra
TxAuxData era
y
  (TxAuxDataF Proof era
Mary TxAuxData era
x) == (TxAuxDataF Proof era
Mary TxAuxData era
y) = AllegraTxAuxData MaryEra
TxAuxData era
x AllegraTxAuxData MaryEra -> AllegraTxAuxData MaryEra -> Bool
forall a. Eq a => a -> a -> Bool
== AllegraTxAuxData MaryEra
TxAuxData era
y
  (TxAuxDataF Proof era
Alonzo TxAuxData era
x) == (TxAuxDataF Proof era
Alonzo TxAuxData era
y) = TxAuxData era
AlonzoTxAuxData AlonzoEra
x AlonzoTxAuxData AlonzoEra -> AlonzoTxAuxData AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxAuxData era
AlonzoTxAuxData AlonzoEra
y
  (TxAuxDataF Proof era
Babbage TxAuxData era
x) == (TxAuxDataF Proof era
Babbage TxAuxData era
y) = TxAuxData era
AlonzoTxAuxData BabbageEra
x AlonzoTxAuxData BabbageEra -> AlonzoTxAuxData BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxAuxData era
AlonzoTxAuxData BabbageEra
y
  (TxAuxDataF Proof era
Conway TxAuxData era
x) == (TxAuxDataF Proof era
Conway TxAuxData era
y) = TxAuxData era
AlonzoTxAuxData ConwayEra
x AlonzoTxAuxData ConwayEra -> AlonzoTxAuxData ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxAuxData era
AlonzoTxAuxData ConwayEra
y

pcAuxData :: Proof era -> TxAuxData era -> PDoc
pcAuxData :: forall era. Proof era -> TxAuxData era -> PDoc
pcAuxData Proof era
p TxAuxData era
_x = String -> PDoc
forall a. String -> Doc a
ppString (String
"TxAuxData " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proof era -> String
forall a. Show a => a -> String
show Proof era
p) -- TODO make this more accurate

genTxAuxDataF :: Proof era -> Gen (TxAuxDataF era)
genTxAuxDataF :: forall era. Proof era -> Gen (TxAuxDataF era)
genTxAuxDataF p :: Proof era
p@Proof era
Shelley = Proof era -> TxAuxData era -> TxAuxDataF era
forall era. Proof era -> TxAuxData era -> TxAuxDataF era
TxAuxDataF Proof era
p (ShelleyTxAuxData ShelleyEra -> TxAuxDataF era)
-> Gen (ShelleyTxAuxData ShelleyEra) -> Gen (TxAuxDataF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxAuxData ShelleyEra)
-> (ShelleyTxAuxData ShelleyEra -> Bool)
-> Gen (ShelleyTxAuxData ShelleyEra)
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen (ShelleyTxAuxData ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary (ProtVer -> TxAuxData ShelleyEra -> Bool
forall era. EraTxAuxData era => ProtVer -> TxAuxData era -> Bool
validateTxAuxData (Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p))
genTxAuxDataF p :: Proof era
p@Proof era
Allegra = Proof era -> TxAuxData era -> TxAuxDataF era
forall era. Proof era -> TxAuxData era -> TxAuxDataF era
TxAuxDataF Proof era
p (AllegraTxAuxData AllegraEra -> TxAuxDataF era)
-> Gen (AllegraTxAuxData AllegraEra) -> Gen (TxAuxDataF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AllegraTxAuxData AllegraEra)
-> (AllegraTxAuxData AllegraEra -> Bool)
-> Gen (AllegraTxAuxData AllegraEra)
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen (AllegraTxAuxData AllegraEra)
forall a. Arbitrary a => Gen a
arbitrary (ProtVer -> TxAuxData AllegraEra -> Bool
forall era. EraTxAuxData era => ProtVer -> TxAuxData era -> Bool
validateTxAuxData (Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p))
genTxAuxDataF p :: Proof era
p@Proof era
Mary = Proof era -> TxAuxData era -> TxAuxDataF era
forall era. Proof era -> TxAuxData era -> TxAuxDataF era
TxAuxDataF Proof era
p (AllegraTxAuxData MaryEra -> TxAuxDataF era)
-> Gen (AllegraTxAuxData MaryEra) -> Gen (TxAuxDataF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AllegraTxAuxData MaryEra)
-> (AllegraTxAuxData MaryEra -> Bool)
-> Gen (AllegraTxAuxData MaryEra)
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen (AllegraTxAuxData MaryEra)
forall a. Arbitrary a => Gen a
arbitrary (ProtVer -> TxAuxData MaryEra -> Bool
forall era. EraTxAuxData era => ProtVer -> TxAuxData era -> Bool
validateTxAuxData (Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p))
genTxAuxDataF p :: Proof era
p@Proof era
Alonzo = Proof era -> TxAuxData era -> TxAuxDataF era
forall era. Proof era -> TxAuxData era -> TxAuxDataF era
TxAuxDataF Proof era
p (AlonzoTxAuxData AlonzoEra -> TxAuxDataF era)
-> Gen (AlonzoTxAuxData AlonzoEra) -> Gen (TxAuxDataF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxAuxData AlonzoEra)
-> (AlonzoTxAuxData AlonzoEra -> Bool)
-> Gen (AlonzoTxAuxData AlonzoEra)
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen (AlonzoTxAuxData AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary (ProtVer -> TxAuxData AlonzoEra -> Bool
forall era. EraTxAuxData era => ProtVer -> TxAuxData era -> Bool
validateTxAuxData (Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p))
genTxAuxDataF p :: Proof era
p@Proof era
Babbage = Proof era -> TxAuxData era -> TxAuxDataF era
forall era. Proof era -> TxAuxData era -> TxAuxDataF era
TxAuxDataF Proof era
p (AlonzoTxAuxData BabbageEra -> TxAuxDataF era)
-> Gen (AlonzoTxAuxData BabbageEra) -> Gen (TxAuxDataF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxAuxData BabbageEra)
-> (AlonzoTxAuxData BabbageEra -> Bool)
-> Gen (AlonzoTxAuxData BabbageEra)
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen (AlonzoTxAuxData BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary (ProtVer -> TxAuxData BabbageEra -> Bool
forall era. EraTxAuxData era => ProtVer -> TxAuxData era -> Bool
validateTxAuxData (Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p))
genTxAuxDataF p :: Proof era
p@Proof era
Conway = Proof era -> TxAuxData era -> TxAuxDataF era
forall era. Proof era -> TxAuxData era -> TxAuxDataF era
TxAuxDataF Proof era
p (AlonzoTxAuxData ConwayEra -> TxAuxDataF era)
-> Gen (AlonzoTxAuxData ConwayEra) -> Gen (TxAuxDataF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoTxAuxData ConwayEra)
-> (AlonzoTxAuxData ConwayEra -> Bool)
-> Gen (AlonzoTxAuxData ConwayEra)
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen (AlonzoTxAuxData ConwayEra)
forall a. Arbitrary a => Gen a
arbitrary (ProtVer -> TxAuxData ConwayEra -> Bool
forall era. EraTxAuxData era => ProtVer -> TxAuxData era -> Bool
validateTxAuxData (Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p))

-- ==============

data TxF era where
  TxF :: Proof era -> Tx era -> TxF era

unTxF :: TxF era -> Tx era
unTxF :: forall era. TxF era -> Tx era
unTxF (TxF Proof era
_ Tx era
x) = Tx era
x

instance PrettyA (TxF era) where
  prettyA :: TxF era -> PDoc
prettyA (TxF Proof era
p Tx era
tx) = Proof era -> Tx era -> PDoc
forall era. Proof era -> Tx era -> PDoc
pcTx Proof era
p Tx era
tx

instance PrettyA (PParamsUpdate era) => Show (TxF era) where
  show :: TxF era -> String
show (TxF Proof era
p Tx era
x) = PDoc -> String
forall a. Show a => a -> String
show (((Reflect era => Proof era -> Tx era -> PDoc)
-> Proof era -> Tx era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> Tx era -> PDoc
Proof era -> Tx era -> PDoc
forall era. Proof era -> Tx era -> PDoc
pcTx Proof era
p Tx era
x) :: PDoc)

instance Eq (TxF era) where
  (TxF Proof era
Shelley Tx era
x) == :: TxF era -> TxF era -> Bool
== (TxF Proof era
Shelley Tx era
y) = Tx era
ShelleyTx ShelleyEra
x ShelleyTx ShelleyEra -> ShelleyTx ShelleyEra -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
ShelleyTx ShelleyEra
y
  (TxF Proof era
Allegra Tx era
x) == (TxF Proof era
Allegra Tx era
y) = Tx era
ShelleyTx AllegraEra
x ShelleyTx AllegraEra -> ShelleyTx AllegraEra -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
ShelleyTx AllegraEra
y
  (TxF Proof era
Mary Tx era
x) == (TxF Proof era
Mary Tx era
y) = Tx era
ShelleyTx MaryEra
x ShelleyTx MaryEra -> ShelleyTx MaryEra -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
ShelleyTx MaryEra
y
  (TxF Proof era
Alonzo Tx era
x) == (TxF Proof era
Alonzo Tx era
y) = Tx era
AlonzoTx AlonzoEra
x AlonzoTx AlonzoEra -> AlonzoTx AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
AlonzoTx AlonzoEra
y
  (TxF Proof era
Babbage Tx era
x) == (TxF Proof era
Babbage Tx era
y) = Tx era
AlonzoTx BabbageEra
x AlonzoTx BabbageEra -> AlonzoTx BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
AlonzoTx BabbageEra
y
  (TxF Proof era
Conway Tx era
x) == (TxF Proof era
Conway Tx era
y) = Tx era
AlonzoTx ConwayEra
x AlonzoTx ConwayEra -> AlonzoTx ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
AlonzoTx ConwayEra
y

-- ==============

data TxWitsF era where
  TxWitsF :: Proof era -> TxWits era -> TxWitsF era

unTxWitsF :: TxWitsF era -> TxWits era
unTxWitsF :: forall era. TxWitsF era -> TxWits era
unTxWitsF (TxWitsF Proof era
_ TxWits era
x) = TxWits era
x

instance Show (TxWitsF era) where
  show :: TxWitsF era -> String
show (TxWitsF Proof era
p TxWits era
x) = PDoc -> String
forall a. Show a => a -> String
show (((Reflect era => Proof era -> TxWits era -> PDoc)
-> Proof era -> TxWits era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxWits era -> PDoc
Proof era -> TxWits era -> PDoc
forall era. Reflect era => Proof era -> TxWits era -> PDoc
pcWitnesses Proof era
p TxWits era
x) :: PDoc)

instance Eq (TxWitsF era) where
  (TxWitsF Proof era
Shelley TxWits era
x) == :: TxWitsF era -> TxWitsF era -> Bool
== (TxWitsF Proof era
Shelley TxWits era
y) = TxWits era
ShelleyTxWits ShelleyEra
x ShelleyTxWits ShelleyEra -> ShelleyTxWits ShelleyEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
ShelleyTxWits ShelleyEra
y
  (TxWitsF Proof era
Allegra TxWits era
x) == (TxWitsF Proof era
Allegra TxWits era
y) = TxWits era
ShelleyTxWits AllegraEra
x ShelleyTxWits AllegraEra -> ShelleyTxWits AllegraEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
ShelleyTxWits AllegraEra
y
  (TxWitsF Proof era
Mary TxWits era
x) == (TxWitsF Proof era
Mary TxWits era
y) = TxWits era
ShelleyTxWits MaryEra
x ShelleyTxWits MaryEra -> ShelleyTxWits MaryEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
ShelleyTxWits MaryEra
y
  (TxWitsF Proof era
Alonzo TxWits era
x) == (TxWitsF Proof era
Alonzo TxWits era
y) = TxWits era
AlonzoTxWits AlonzoEra
x AlonzoTxWits AlonzoEra -> AlonzoTxWits AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
AlonzoTxWits AlonzoEra
y
  (TxWitsF Proof era
Babbage TxWits era
x) == (TxWitsF Proof era
Babbage TxWits era
y) = TxWits era
AlonzoTxWits BabbageEra
x AlonzoTxWits BabbageEra -> AlonzoTxWits BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
AlonzoTxWits BabbageEra
y
  (TxWitsF Proof era
Conway TxWits era
x) == (TxWitsF Proof era
Conway TxWits era
y) = TxWits era
AlonzoTxWits ConwayEra
x AlonzoTxWits ConwayEra -> AlonzoTxWits ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
AlonzoTxWits ConwayEra
y

-- ==============================

data TxBodyF era where
  TxBodyF :: Proof era -> TxBody era -> TxBodyF era

unTxBodyF :: TxBodyF era -> TxBody era
unTxBodyF :: forall era. TxBodyF era -> TxBody era
unTxBodyF (TxBodyF Proof era
_ TxBody era
x) = TxBody era
x

instance PrettyA (PParamsUpdate era) => Show (TxBodyF era) where
  show :: TxBodyF era -> String
show (TxBodyF Proof era
p TxBody era
x) = PDoc -> String
forall a. Show a => a -> String
show (((Reflect era => Proof era -> TxBody era -> PDoc)
-> Proof era -> TxBody era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxBody era -> PDoc
Proof era -> TxBody era -> PDoc
forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof era
p TxBody era
x) :: PDoc)

instance PrettyA (TxBodyF era) where
  prettyA :: TxBodyF era -> PDoc
prettyA (TxBodyF Proof era
p TxBody era
x) = (Reflect era => Proof era -> TxBody era -> PDoc)
-> Proof era -> TxBody era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxBody era -> PDoc
Proof era -> TxBody era -> PDoc
forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof era
p TxBody era
x

instance Eq (TxBodyF era) where
  (TxBodyF Proof era
Shelley TxBody era
x) == :: TxBodyF era -> TxBodyF era -> Bool
== (TxBodyF Proof era
Shelley TxBody era
y) = TxBody era
x TxBody era -> TxBody era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody era
y
  (TxBodyF Proof era
Allegra TxBody era
x) == (TxBodyF Proof era
Allegra TxBody era
y) = TxBody era
x TxBody era -> TxBody era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody era
y
  (TxBodyF Proof era
Mary TxBody era
x) == (TxBodyF Proof era
Mary TxBody era
y) = TxBody era
x TxBody era -> TxBody era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody era
y
  (TxBodyF Proof era
Alonzo TxBody era
x) == (TxBodyF Proof era
Alonzo TxBody era
y) = TxBody era
x TxBody era -> TxBody era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody era
y
  (TxBodyF Proof era
Babbage TxBody era
x) == (TxBodyF Proof era
Babbage TxBody era
y) = TxBody era
x TxBody era -> TxBody era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody era
y
  (TxBodyF Proof era
Conway TxBody era
x) == (TxBodyF Proof era
Conway TxBody era
y) = TxBody era
x TxBody era -> TxBody era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody era
y

-- ==================
data TxCertF era where
  TxCertF :: Proof era -> TxCert era -> TxCertF era

unTxCertF :: TxCertF era -> TxCert era
unTxCertF :: forall era. TxCertF era -> TxCert era
unTxCertF (TxCertF Proof era
_ TxCert era
x) = TxCert era
x

instance PrettyA (TxCertF era) where
  prettyA :: TxCertF era -> PDoc
prettyA (TxCertF Proof era
p TxCert era
x) = Proof era -> TxCert era -> PDoc
forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof era
p TxCert era
x

instance Show (TxCertF era) where
  show :: TxCertF era -> String
show (TxCertF Proof era
p TxCert era
x) = PDoc -> String
forall a. Show a => a -> String
show (Proof era -> TxCert era -> PDoc
forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof era
p TxCert era
x)

instance Eq (TxCertF era) where
  (TxCertF Proof era
Shelley TxCert era
x) == :: TxCertF era -> TxCertF era -> Bool
== (TxCertF Proof era
Shelley TxCert era
y) = TxCert era
ShelleyTxCert ShelleyEra
x ShelleyTxCert ShelleyEra -> ShelleyTxCert ShelleyEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxCert era
ShelleyTxCert ShelleyEra
y
  (TxCertF Proof era
Allegra TxCert era
x) == (TxCertF Proof era
Allegra TxCert era
y) = TxCert era
ShelleyTxCert AllegraEra
x ShelleyTxCert AllegraEra -> ShelleyTxCert AllegraEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxCert era
ShelleyTxCert AllegraEra
y
  (TxCertF Proof era
Mary TxCert era
x) == (TxCertF Proof era
Mary TxCert era
y) = TxCert era
ShelleyTxCert MaryEra
x ShelleyTxCert MaryEra -> ShelleyTxCert MaryEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxCert era
ShelleyTxCert MaryEra
y
  (TxCertF Proof era
Alonzo TxCert era
x) == (TxCertF Proof era
Alonzo TxCert era
y) = TxCert era
ShelleyTxCert AlonzoEra
x ShelleyTxCert AlonzoEra -> ShelleyTxCert AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxCert era
ShelleyTxCert AlonzoEra
y
  (TxCertF Proof era
Babbage TxCert era
x) == (TxCertF Proof era
Babbage TxCert era
y) = TxCert era
ShelleyTxCert BabbageEra
x ShelleyTxCert BabbageEra -> ShelleyTxCert BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxCert era
ShelleyTxCert BabbageEra
y
  (TxCertF Proof era
Conway TxCert era
x) == (TxCertF Proof era
Conway TxCert era
y) = TxCert era
ConwayTxCert ConwayEra
x ConwayTxCert ConwayEra -> ConwayTxCert ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== TxCert era
ConwayTxCert ConwayEra
y

-- ==================
data PlutusPurposeF era where
  PlutusPurposeF :: Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era

unPlutusPurposeF :: PlutusPurposeF era -> PlutusPurpose AsIxItem era
unPlutusPurposeF :: forall era. PlutusPurposeF era -> PlutusPurpose AsIxItem era
unPlutusPurposeF (PlutusPurposeF Proof era
_ PlutusPurpose AsIxItem era
pp) = PlutusPurpose AsIxItem era
pp

data PlutusPointerF era where
  PlutusPointerF :: Proof era -> PlutusPurpose AsIx era -> PlutusPointerF era

unPlutusPointerF :: PlutusPointerF era -> PlutusPurpose AsIx era
unPlutusPointerF :: forall era. PlutusPointerF era -> PlutusPurpose AsIx era
unPlutusPointerF (PlutusPointerF Proof era
_ PlutusPurpose AsIx era
pp) = PlutusPurpose AsIx era
pp

instance Show (PlutusPurposeF era) where
  show :: PlutusPurposeF era -> String
show (PlutusPurposeF Proof era
p PlutusPurpose AsIxItem era
x) = (Reflect era => Proof era -> String) -> Proof era -> String
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect (\Proof era
_ -> PDoc -> String
forall a. Show a => a -> String
show (PlutusPurpose AsIxItem era -> PDoc
forall era. Reflect era => PlutusPurpose AsIxItem era -> PDoc
ppPlutusPurposeAsIxItem PlutusPurpose AsIxItem era
x)) Proof era
p

instance Show (PlutusPointerF era) where
  show :: PlutusPointerF era -> String
show (PlutusPointerF Proof era
p PlutusPurpose AsIx era
x) = (Reflect era => Proof era -> String) -> Proof era -> String
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect (\Proof era
_ -> PDoc -> String
forall a. Show a => a -> String
show (PlutusPurpose AsIx era -> PDoc
forall era. Reflect era => PlutusPurpose AsIx era -> PDoc
ppPlutusPurposeAsIx PlutusPurpose AsIx era
x)) Proof era
p

instance Eq (PlutusPurposeF era) where
  PlutusPurposeF Proof era
Alonzo PlutusPurpose AsIxItem era
x == :: PlutusPurposeF era -> PlutusPurposeF era -> Bool
== PlutusPurposeF Proof era
Alonzo PlutusPurpose AsIxItem era
y = AlonzoPlutusPurpose AsIxItem AlonzoEra
PlutusPurpose AsIxItem era
x AlonzoPlutusPurpose AsIxItem AlonzoEra
-> AlonzoPlutusPurpose AsIxItem AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== AlonzoPlutusPurpose AsIxItem AlonzoEra
PlutusPurpose AsIxItem era
y
  PlutusPurposeF Proof era
Babbage PlutusPurpose AsIxItem era
x == PlutusPurposeF Proof era
Babbage PlutusPurpose AsIxItem era
y = AlonzoPlutusPurpose AsIxItem BabbageEra
PlutusPurpose AsIxItem era
x AlonzoPlutusPurpose AsIxItem BabbageEra
-> AlonzoPlutusPurpose AsIxItem BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== AlonzoPlutusPurpose AsIxItem BabbageEra
PlutusPurpose AsIxItem era
y
  PlutusPurposeF Proof era
Conway PlutusPurpose AsIxItem era
x == PlutusPurposeF Proof era
Conway PlutusPurpose AsIxItem era
y = PlutusPurpose AsIxItem era
ConwayPlutusPurpose AsIxItem ConwayEra
x ConwayPlutusPurpose AsIxItem ConwayEra
-> ConwayPlutusPurpose AsIxItem ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusPurpose AsIxItem era
ConwayPlutusPurpose AsIxItem ConwayEra
y
  PlutusPurposeF era
_ == PlutusPurposeF era
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"Unsupported"

instance Eq (PlutusPointerF era) where
  PlutusPointerF Proof era
Alonzo PlutusPurpose AsIx era
x == :: PlutusPointerF era -> PlutusPointerF era -> Bool
== PlutusPointerF Proof era
Alonzo PlutusPurpose AsIx era
y = AlonzoPlutusPurpose AsIx AlonzoEra
PlutusPurpose AsIx era
x AlonzoPlutusPurpose AsIx AlonzoEra
-> AlonzoPlutusPurpose AsIx AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== AlonzoPlutusPurpose AsIx AlonzoEra
PlutusPurpose AsIx era
y
  PlutusPointerF Proof era
Babbage PlutusPurpose AsIx era
x == PlutusPointerF Proof era
Babbage PlutusPurpose AsIx era
y = AlonzoPlutusPurpose AsIx BabbageEra
PlutusPurpose AsIx era
x AlonzoPlutusPurpose AsIx BabbageEra
-> AlonzoPlutusPurpose AsIx BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== AlonzoPlutusPurpose AsIx BabbageEra
PlutusPurpose AsIx era
y
  PlutusPointerF Proof era
Conway PlutusPurpose AsIx era
x == PlutusPointerF Proof era
Conway PlutusPurpose AsIx era
y = PlutusPurpose AsIx era
ConwayPlutusPurpose AsIx ConwayEra
x ConwayPlutusPurpose AsIx ConwayEra
-> ConwayPlutusPurpose AsIx ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusPurpose AsIx era
ConwayPlutusPurpose AsIx ConwayEra
y
  PlutusPointerF era
_ == PlutusPointerF era
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"Unsupported"

instance Ord (PlutusPointerF era) where
  compare :: PlutusPointerF era -> PlutusPointerF era -> Ordering
compare (PlutusPointerF Proof era
Alonzo PlutusPurpose AsIx era
x) (PlutusPointerF Proof era
Alonzo PlutusPurpose AsIx era
y) = AlonzoPlutusPurpose AsIx AlonzoEra
-> AlonzoPlutusPurpose AsIx AlonzoEra -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AlonzoPlutusPurpose AsIx AlonzoEra
PlutusPurpose AsIx era
x AlonzoPlutusPurpose AsIx AlonzoEra
PlutusPurpose AsIx era
y
  compare (PlutusPointerF Proof era
Babbage PlutusPurpose AsIx era
x) (PlutusPointerF Proof era
Babbage PlutusPurpose AsIx era
y) = AlonzoPlutusPurpose AsIx BabbageEra
-> AlonzoPlutusPurpose AsIx BabbageEra -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AlonzoPlutusPurpose AsIx BabbageEra
PlutusPurpose AsIx era
x AlonzoPlutusPurpose AsIx BabbageEra
PlutusPurpose AsIx era
y
  compare (PlutusPointerF Proof era
Conway PlutusPurpose AsIx era
x) (PlutusPointerF Proof era
Conway PlutusPurpose AsIx era
y) = ConwayPlutusPurpose AsIx ConwayEra
-> ConwayPlutusPurpose AsIx ConwayEra -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PlutusPurpose AsIx era
ConwayPlutusPurpose AsIx ConwayEra
x PlutusPurpose AsIx era
ConwayPlutusPurpose AsIx ConwayEra
y
  compare PlutusPointerF era
_ PlutusPointerF era
_ = String -> Ordering
forall a. HasCallStack => String -> a
error String
"Unsupported"

-- =========
data TxOutF era where
  TxOutF :: Proof era -> TxOut era -> TxOutF era

unTxOut :: TxOutF era -> TxOut era
unTxOut :: forall era. TxOutF era -> TxOut era
unTxOut (TxOutF Proof era
_ TxOut era
x) = TxOut era
x

instance PrettyA (TxOutF era) where
  prettyA :: TxOutF era -> PDoc
prettyA (TxOutF Proof era
p TxOut era
x) = (Reflect era => Proof era -> TxOut era -> PDoc)
-> Proof era -> TxOut era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxOut era -> PDoc
Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
p TxOut era
x

instance Eq (TxOutF era) where
  TxOutF era
x1 == :: TxOutF era -> TxOutF era -> Bool
== TxOutF era
x2 = TxOutF era -> TxOutF era -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TxOutF era
x1 TxOutF era
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord (TxOutF era) where
  compare :: TxOutF era -> TxOutF era -> Ordering
compare (TxOutF Proof era
Shelley (ShelleyTxOut Addr
a1 Value ShelleyEra
v1)) (TxOutF Proof era
Shelley (ShelleyTxOut Addr
a2 Value ShelleyEra
v2)) =
    Addr -> Addr -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Addr
a1 Addr
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Coin -> Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Value ShelleyEra
Coin
v1 Value ShelleyEra
Coin
v2
  compare (TxOutF Proof era
Allegra (ShelleyTxOut Addr
a1 Value AllegraEra
v1)) (TxOutF Proof era
Allegra (ShelleyTxOut Addr
a2 Value AllegraEra
v2)) =
    (Addr, Coin) -> (Addr, Coin) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Addr
a1, Value AllegraEra
Coin
v1) (Addr
a2, Value AllegraEra
Coin
v2)
  compare (TxOutF Proof era
Mary (ShelleyTxOut Addr
a1 Value MaryEra
v1)) (TxOutF Proof era
Mary (ShelleyTxOut Addr
a2 Value MaryEra
v2)) =
    (Addr, MaryValue) -> (Addr, MaryValue) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Addr
a1, Value MaryEra
MaryValue
v1) (Addr
a2, Value MaryEra
MaryValue
v2)
  compare (TxOutF Proof era
Alonzo (AlonzoTxOut Addr
a1 Value AlonzoEra
v1 StrictMaybe DataHash
d1)) (TxOutF Proof era
Alonzo (AlonzoTxOut Addr
a2 Value AlonzoEra
v2 StrictMaybe DataHash
d2)) =
    (Addr, MaryValue, StrictMaybe DataHash)
-> (Addr, MaryValue, StrictMaybe DataHash) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Addr
a1, Value AlonzoEra
MaryValue
v1, StrictMaybe DataHash
d1) (Addr
a2, Value AlonzoEra
MaryValue
v2, StrictMaybe DataHash
d2)
  compare (TxOutF Proof era
Babbage (BabbageTxOut Addr
a1 Value BabbageEra
v1 Datum BabbageEra
d1 StrictMaybe (Script BabbageEra)
x1)) (TxOutF Proof era
Babbage (BabbageTxOut Addr
a2 Value BabbageEra
v2 Datum BabbageEra
d2 StrictMaybe (Script BabbageEra)
x2)) =
    (Addr, MaryValue, Datum BabbageEra, StrictMaybe ScriptHash)
-> (Addr, MaryValue, Datum BabbageEra, StrictMaybe ScriptHash)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Addr
a1, Value BabbageEra
MaryValue
v1, Datum BabbageEra
d1, (Script BabbageEra -> ScriptHash)
-> StrictMaybe (Script BabbageEra) -> StrictMaybe ScriptHash
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script BabbageEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript StrictMaybe (Script BabbageEra)
x1) (Addr
a2, Value BabbageEra
MaryValue
v2, Datum BabbageEra
d2, (Script BabbageEra -> ScriptHash)
-> StrictMaybe (Script BabbageEra) -> StrictMaybe ScriptHash
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script BabbageEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript StrictMaybe (Script BabbageEra)
x2)
  compare (TxOutF Proof era
Conway (BabbageTxOut Addr
a1 Value ConwayEra
v1 Datum ConwayEra
d1 StrictMaybe (Script ConwayEra)
x1)) (TxOutF Proof era
Conway (BabbageTxOut Addr
a2 Value ConwayEra
v2 Datum ConwayEra
d2 StrictMaybe (Script ConwayEra)
x2)) =
    (Addr, MaryValue, Datum ConwayEra, StrictMaybe ScriptHash)
-> (Addr, MaryValue, Datum ConwayEra, StrictMaybe ScriptHash)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Addr
a1, Value ConwayEra
MaryValue
v1, Datum ConwayEra
d1, (Script ConwayEra -> ScriptHash)
-> StrictMaybe (Script ConwayEra) -> StrictMaybe ScriptHash
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script ConwayEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript StrictMaybe (Script ConwayEra)
x1) (Addr
a2, Value ConwayEra
MaryValue
v2, Datum ConwayEra
d2, (Script ConwayEra -> ScriptHash)
-> StrictMaybe (Script ConwayEra) -> StrictMaybe ScriptHash
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script ConwayEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript StrictMaybe (Script ConwayEra)
x2)

-- ======
data ValueF era where
  ValueF :: Proof era -> Value era -> ValueF era

instance PrettyA (ValueF era) where
  prettyA :: ValueF era -> PDoc
prettyA (ValueF Proof era
p Value era
v) = Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcVal Proof era
p Value era
v

unValue :: ValueF era -> Value era
unValue :: forall era. ValueF era -> Value era
unValue (ValueF Proof era
_ Value era
v) = Value era
v

instance Ord MaryValue where
  compare :: MaryValue -> MaryValue -> Ordering
compare (MaryValue Coin
c1 MultiAsset
m1) (MaryValue Coin
c2 MultiAsset
m2) = (Coin, MultiAsset) -> (Coin, MultiAsset) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Coin
c1, MultiAsset
m1) (Coin
c2, MultiAsset
m2)

instance Ord MultiAsset where
  compare :: MultiAsset -> MultiAsset -> Ordering
compare (MultiAsset Map PolicyID (Map AssetName Integer)
m1) (MultiAsset Map PolicyID (Map AssetName Integer)
m2) = Map PolicyID (Map AssetName Integer)
-> Map PolicyID (Map AssetName Integer) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Map PolicyID (Map AssetName Integer)
m1 Map PolicyID (Map AssetName Integer)
m2

instance Eq (ValueF era) where
  ValueF era
x == :: ValueF era -> ValueF era -> Bool
== ValueF era
y = ValueF era -> ValueF era -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ValueF era
x ValueF era
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord (ValueF era) where
  (ValueF Proof era
Shelley Value era
x) compare :: ValueF era -> ValueF era -> Ordering
`compare` (ValueF Proof era
Shelley Value era
y) = Coin -> Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Value era
Coin
x Value era
Coin
y
  (ValueF Proof era
Allegra Value era
x) `compare` (ValueF Proof era
Allegra Value era
y) = Coin -> Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Value era
Coin
x Value era
Coin
y
  (ValueF Proof era
Mary (MaryValue Coin
c1 MultiAsset
m1)) `compare` (ValueF Proof era
Mary (MaryValue Coin
c2 MultiAsset
m2)) = Coin -> Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Coin
c1 Coin
c2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> MultiAsset -> MultiAsset -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MultiAsset
m1 MultiAsset
m2
  (ValueF Proof era
Alonzo (MaryValue Coin
c1 MultiAsset
m1)) `compare` (ValueF Proof era
Alonzo (MaryValue Coin
c2 MultiAsset
m2)) = Coin -> Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Coin
c1 Coin
c2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> MultiAsset -> MultiAsset -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MultiAsset
m1 MultiAsset
m2
  (ValueF Proof era
Babbage (MaryValue Coin
c1 MultiAsset
m1)) `compare` (ValueF Proof era
Babbage (MaryValue Coin
c2 MultiAsset
m2)) = Coin -> Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Coin
c1 Coin
c2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> MultiAsset -> MultiAsset -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MultiAsset
m1 MultiAsset
m2
  (ValueF Proof era
Conway (MaryValue Coin
c1 MultiAsset
m1)) `compare` (ValueF Proof era
Conway (MaryValue Coin
c2 MultiAsset
m2)) = Coin -> Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Coin
c1 Coin
c2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> MultiAsset -> MultiAsset -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MultiAsset
m1 MultiAsset
m2

-- ======
data PParamsF era where
  PParamsF :: Proof era -> PParams era -> PParamsF era

unPParams :: PParamsF era -> PParams era
unPParams :: forall era. PParamsF era -> PParams era
unPParams (PParamsF Proof era
_ PParams era
p) = PParams era
p

instance PrettyA (PParamsF era) where
  prettyA :: PParamsF era -> PDoc
prettyA (PParamsF Proof era
p PParams era
x) = (Reflect era => Proof era -> PParams era -> PDoc)
-> Proof era -> PParams era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> PParams era -> PDoc
Proof era -> PParams era -> PDoc
forall era. Proof era -> PParams era -> PDoc
pcPParams Proof era
p PParams era
x

instance Eq (PParamsF era) where
  PParamsF Proof era
p1 PParams era
x == :: PParamsF era -> PParamsF era -> Bool
== PParamsF Proof era
_ PParams era
y =
    case Proof era
p1 of
      Proof era
Shelley -> PParams era
x PParams era -> PParams era -> Bool
forall a. Eq a => a -> a -> Bool
== PParams era
y
      Proof era
Allegra -> PParams era
x PParams era -> PParams era -> Bool
forall a. Eq a => a -> a -> Bool
== PParams era
y
      Proof era
Mary -> PParams era
x PParams era -> PParams era -> Bool
forall a. Eq a => a -> a -> Bool
== PParams era
y
      Proof era
Alonzo -> PParams era
x PParams era -> PParams era -> Bool
forall a. Eq a => a -> a -> Bool
== PParams era
y
      Proof era
Babbage -> PParams era
x PParams era -> PParams era -> Bool
forall a. Eq a => a -> a -> Bool
== PParams era
y
      Proof era
Conway -> PParams era
x PParams era -> PParams era -> Bool
forall a. Eq a => a -> a -> Bool
== PParams era
y

pparamsWrapperL :: Lens' (PParamsF era) (PParams era)
pparamsWrapperL :: forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> PParamsF era -> f (PParamsF era)
pparamsWrapperL = (PParamsF era -> PParams era)
-> (PParamsF era -> PParams era -> PParamsF era)
-> Lens (PParamsF era) (PParamsF era) (PParams era) (PParams era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PParamsF era -> PParams era
forall era. PParamsF era -> PParams era
unPParams (\(PParamsF Proof era
p PParams era
_) PParams era
pp -> Proof era -> PParams era -> PParamsF era
forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p PParams era
pp)

-- =======

data PParamsUpdateF era where
  PParamsUpdateF :: Proof era -> PParamsUpdate era -> PParamsUpdateF era

unPParamsUpdate :: PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate :: forall era. PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate (PParamsUpdateF Proof era
_ PParamsUpdate era
p) = PParamsUpdate era
p

pparamsUpdateWrapperL :: Lens' (PParamsUpdateF era) (PParamsUpdate era)
pparamsUpdateWrapperL :: forall era (f :: * -> *).
Functor f =>
(PParamsUpdate era -> f (PParamsUpdate era))
-> PParamsUpdateF era -> f (PParamsUpdateF era)
pparamsUpdateWrapperL = (PParamsUpdateF era -> PParamsUpdate era)
-> (PParamsUpdateF era -> PParamsUpdate era -> PParamsUpdateF era)
-> Lens
     (PParamsUpdateF era)
     (PParamsUpdateF era)
     (PParamsUpdate era)
     (PParamsUpdate era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PParamsUpdateF era -> PParamsUpdate era
forall era. PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate (\(PParamsUpdateF Proof era
p PParamsUpdate era
_) PParamsUpdate era
pp -> Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p PParamsUpdate era
pp)

-- =====================

data ProposedPPUpdatesF era where
  ProposedPPUpdatesF :: Proof era -> PP.ProposedPPUpdates era -> ProposedPPUpdatesF era

unProposedPPUpdates :: ProposedPPUpdatesF era -> PP.ProposedPPUpdates era
unProposedPPUpdates :: forall era. ProposedPPUpdatesF era -> ProposedPPUpdates era
unProposedPPUpdates (ProposedPPUpdatesF Proof era
_ ProposedPPUpdates era
x) = ProposedPPUpdates era
x

instance PrettyA (PParamsUpdate e) => PrettyA (ProposedPPUpdatesF e) where
  prettyA :: ProposedPPUpdatesF e -> PDoc
prettyA (ProposedPPUpdatesF Proof e
_p ProposedPPUpdates e
x) = ProposedPPUpdates e -> PDoc
forall era.
PrettyA (PParamsUpdate era) =>
ProposedPPUpdates era -> PDoc
ppProposedPPUpdates ProposedPPUpdates e
x

proposedCoreL ::
  Lens' (PP.ProposedPPUpdates era) (Map (KeyHash 'Genesis) (PParamsUpdate era))
proposedCoreL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> f (Map (KeyHash 'Genesis) (PParamsUpdate era)))
-> ProposedPPUpdates era -> f (ProposedPPUpdates era)
proposedCoreL = (ProposedPPUpdates era
 -> Map (KeyHash 'Genesis) (PParamsUpdate era))
-> (ProposedPPUpdates era
    -> Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> ProposedPPUpdates era)
-> Lens
     (ProposedPPUpdates era)
     (ProposedPPUpdates era)
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(PP.ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate era)
m) -> Map (KeyHash 'Genesis) (PParamsUpdate era)
m) (\(PP.ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate era)
_) Map (KeyHash 'Genesis) (PParamsUpdate era)
m -> Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
PP.ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate era)
m)

proposedWrapperL :: Lens' (ProposedPPUpdatesF era) (PP.ProposedPPUpdates era)
proposedWrapperL :: forall era (f :: * -> *).
Functor f =>
(ProposedPPUpdates era -> f (ProposedPPUpdates era))
-> ProposedPPUpdatesF era -> f (ProposedPPUpdatesF era)
proposedWrapperL = (ProposedPPUpdatesF era -> ProposedPPUpdates era)
-> (ProposedPPUpdatesF era
    -> ProposedPPUpdates era -> ProposedPPUpdatesF era)
-> Lens
     (ProposedPPUpdatesF era)
     (ProposedPPUpdatesF era)
     (ProposedPPUpdates era)
     (ProposedPPUpdates era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProposedPPUpdatesF era -> ProposedPPUpdates era
forall era. ProposedPPUpdatesF era -> ProposedPPUpdates era
unProposedPPUpdates (\(ProposedPPUpdatesF Proof era
p ProposedPPUpdates era
_) ProposedPPUpdates era
pp -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p ProposedPPUpdates era
pp)

coreMapL ::
  Proof era ->
  Lens'
    (Map (KeyHash 'Genesis) (PParamsUpdate era))
    (Map (KeyHash 'Genesis) (PParamsUpdateF era))
coreMapL :: forall era.
Proof era
-> Lens'
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
coreMapL Proof era
p = (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> Map (KeyHash 'Genesis) (PParamsUpdateF era))
-> (Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> Map (KeyHash 'Genesis) (PParamsUpdateF era)
    -> Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Lens
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ((PParamsUpdate era -> PParamsUpdateF era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> Map (KeyHash 'Genesis) (PParamsUpdateF era)
forall a b.
(a -> b) -> Map (KeyHash 'Genesis) a -> Map (KeyHash 'Genesis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p)) (\Map (KeyHash 'Genesis) (PParamsUpdate era)
_ Map (KeyHash 'Genesis) (PParamsUpdateF era)
b -> (PParamsUpdateF era -> PParamsUpdate era)
-> Map (KeyHash 'Genesis) (PParamsUpdateF era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
forall a b.
(a -> b) -> Map (KeyHash 'Genesis) a -> Map (KeyHash 'Genesis) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PParamsUpdateF era -> PParamsUpdate era
forall era. PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate Map (KeyHash 'Genesis) (PParamsUpdateF era)
b)

proposedMapL ::
  Lens' (ProposedPPUpdatesF era) (Map (KeyHash 'Genesis) (PParamsUpdateF era))
proposedMapL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'Genesis) (PParamsUpdateF era)
 -> f (Map (KeyHash 'Genesis) (PParamsUpdateF era)))
-> ProposedPPUpdatesF era -> f (ProposedPPUpdatesF era)
proposedMapL =
  (ProposedPPUpdatesF era
 -> Map (KeyHash 'Genesis) (PParamsUpdateF era))
-> (ProposedPPUpdatesF era
    -> Map (KeyHash 'Genesis) (PParamsUpdateF era)
    -> ProposedPPUpdatesF era)
-> Lens
     (ProposedPPUpdatesF era)
     (ProposedPPUpdatesF era)
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(ProposedPPUpdatesF Proof era
p ProposedPPUpdates era
x) -> ProposedPPUpdates era
x ProposedPPUpdates era
-> Getting
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
     (ProposedPPUpdates era)
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
-> Map (KeyHash 'Genesis) (PParamsUpdateF era)
forall s a. s -> Getting a s a -> a
^. ((Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> Const
      (Map (KeyHash 'Genesis) (PParamsUpdateF era))
      (Map (KeyHash 'Genesis) (PParamsUpdate era)))
-> ProposedPPUpdates era
-> Const
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
     (ProposedPPUpdates era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> f (Map (KeyHash 'Genesis) (PParamsUpdate era)))
-> ProposedPPUpdates era -> f (ProposedPPUpdates era)
proposedCoreL ((Map (KeyHash 'Genesis) (PParamsUpdate era)
  -> Const
       (Map (KeyHash 'Genesis) (PParamsUpdateF era))
       (Map (KeyHash 'Genesis) (PParamsUpdate era)))
 -> ProposedPPUpdates era
 -> Const
      (Map (KeyHash 'Genesis) (PParamsUpdateF era))
      (ProposedPPUpdates era))
-> ((Map (KeyHash 'Genesis) (PParamsUpdateF era)
     -> Const
          (Map (KeyHash 'Genesis) (PParamsUpdateF era))
          (Map (KeyHash 'Genesis) (PParamsUpdateF era)))
    -> Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> Const
         (Map (KeyHash 'Genesis) (PParamsUpdateF era))
         (Map (KeyHash 'Genesis) (PParamsUpdate era)))
-> Getting
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
     (ProposedPPUpdates era)
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof era
-> Lens'
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
forall era.
Proof era
-> Lens'
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
coreMapL Proof era
p))
    (\(ProposedPPUpdatesF Proof era
p ProposedPPUpdates era
x) Map (KeyHash 'Genesis) (PParamsUpdateF era)
y -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p (ProposedPPUpdates era
x ProposedPPUpdates era
-> (ProposedPPUpdates era -> ProposedPPUpdates era)
-> ProposedPPUpdates era
forall a b. a -> (a -> b) -> b
& ((Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> Identity (Map (KeyHash 'Genesis) (PParamsUpdate era)))
-> ProposedPPUpdates era -> Identity (ProposedPPUpdates era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> f (Map (KeyHash 'Genesis) (PParamsUpdate era)))
-> ProposedPPUpdates era -> f (ProposedPPUpdates era)
proposedCoreL ((Map (KeyHash 'Genesis) (PParamsUpdate era)
  -> Identity (Map (KeyHash 'Genesis) (PParamsUpdate era)))
 -> ProposedPPUpdates era -> Identity (ProposedPPUpdates era))
-> ((Map (KeyHash 'Genesis) (PParamsUpdateF era)
     -> Identity (Map (KeyHash 'Genesis) (PParamsUpdateF era)))
    -> Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> Identity (Map (KeyHash 'Genesis) (PParamsUpdate era)))
-> (Map (KeyHash 'Genesis) (PParamsUpdateF era)
    -> Identity (Map (KeyHash 'Genesis) (PParamsUpdateF era)))
-> ProposedPPUpdates era
-> Identity (ProposedPPUpdates era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof era
-> Lens'
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
forall era.
Proof era
-> Lens'
     (Map (KeyHash 'Genesis) (PParamsUpdate era))
     (Map (KeyHash 'Genesis) (PParamsUpdateF era))
coreMapL Proof era
p) ((Map (KeyHash 'Genesis) (PParamsUpdateF era)
  -> Identity (Map (KeyHash 'Genesis) (PParamsUpdateF era)))
 -> ProposedPPUpdates era -> Identity (ProposedPPUpdates era))
-> Map (KeyHash 'Genesis) (PParamsUpdateF era)
-> ProposedPPUpdates era
-> ProposedPPUpdates era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (KeyHash 'Genesis) (PParamsUpdateF era)
y))

-- ====================

data CertStateF era where
  CertStateF :: Proof era -> CertState era -> CertStateF era

unCertStateF :: CertStateF era -> CertState era
unCertStateF :: forall era. CertStateF era -> CertState era
unCertStateF (CertStateF Proof era
_ CertState era
x) = CertState era
x

instance Reflect era => PrettyA (CertStateF era) where
  prettyA :: CertStateF era -> PDoc
prettyA (CertStateF Proof era
_ CertState era
x) = CertState era -> PDoc
forall era. Reflect era => CertState era -> PDoc
pcCertState CertState era
x

instance Eq (CertStateF era) where
  (CertStateF Proof era
Shelley CertState era
x) == :: CertStateF era -> CertStateF era -> Bool
== (CertStateF Proof era
Shelley CertState era
y) = CertState era
ShelleyCertState ShelleyEra
x ShelleyCertState ShelleyEra -> ShelleyCertState ShelleyEra -> Bool
forall a. Eq a => a -> a -> Bool
== CertState era
ShelleyCertState ShelleyEra
y
  (CertStateF Proof era
Allegra CertState era
x) == (CertStateF Proof era
Allegra CertState era
y) = CertState era
ShelleyCertState AllegraEra
x ShelleyCertState AllegraEra -> ShelleyCertState AllegraEra -> Bool
forall a. Eq a => a -> a -> Bool
== CertState era
ShelleyCertState AllegraEra
y
  (CertStateF Proof era
Mary CertState era
x) == (CertStateF Proof era
Mary CertState era
y) = CertState era
ShelleyCertState MaryEra
x ShelleyCertState MaryEra -> ShelleyCertState MaryEra -> Bool
forall a. Eq a => a -> a -> Bool
== CertState era
ShelleyCertState MaryEra
y
  (CertStateF Proof era
Alonzo CertState era
x) == (CertStateF Proof era
Alonzo CertState era
y) = CertState era
ShelleyCertState AlonzoEra
x ShelleyCertState AlonzoEra -> ShelleyCertState AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== CertState era
ShelleyCertState AlonzoEra
y
  (CertStateF Proof era
Babbage CertState era
x) == (CertStateF Proof era
Babbage CertState era
y) = CertState era
ShelleyCertState BabbageEra
x ShelleyCertState BabbageEra -> ShelleyCertState BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== CertState era
ShelleyCertState BabbageEra
y
  (CertStateF Proof era
Conway CertState era
x) == (CertStateF Proof era
Conway CertState era
y) = CertState era
ConwayCertState ConwayEra
x ConwayCertState ConwayEra -> ConwayCertState ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== CertState era
ConwayCertState ConwayEra
y

-- ====================

data GovState era = GovState (Proof era) (Gov.GovState era)

unGovState :: GovState era -> Gov.GovState era
unGovState :: forall era. GovState era -> GovState era
unGovState (GovState Proof era
_ GovState era
x) = GovState era
x

govProposedL :: Lens' (GovState era) (ShelleyGovState era)
govProposedL :: forall era (f :: * -> *).
Functor f =>
(ShelleyGovState era -> f (ShelleyGovState era))
-> GovState era -> f (GovState era)
govProposedL =
  (GovState era -> ShelleyGovState era)
-> (GovState era -> ShelleyGovState era -> GovState era)
-> Lens
     (GovState era)
     (GovState era)
     (ShelleyGovState era)
     (ShelleyGovState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(GovState Proof era
p GovState era
x) -> Proof era -> GovState era -> ShelleyGovState era
forall era. Proof era -> GovState era -> ShelleyGovState era
getPPUP Proof era
p GovState era
x)
    (\(GovState Proof era
p GovState era
_) ShelleyGovState era
y -> Proof era -> GovState era -> GovState era
forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p (Proof era -> ShelleyGovState era -> GovState era
forall era. Proof era -> ShelleyGovState era -> GovState era
putPPUP Proof era
p ShelleyGovState era
y))

getPPUP :: forall era. Proof era -> Gov.GovState era -> ShelleyGovState era
getPPUP :: forall era. Proof era -> GovState era -> ShelleyGovState era
getPPUP Proof era
Shelley GovState era
x = GovState era
ShelleyGovState era
x
getPPUP Proof era
Allegra GovState era
x = GovState era
ShelleyGovState era
x
getPPUP Proof era
Mary GovState era
x = GovState era
ShelleyGovState era
x
getPPUP Proof era
Alonzo GovState era
x = GovState era
ShelleyGovState era
x
getPPUP Proof era
Babbage GovState era
x = GovState era
ShelleyGovState era
x
getPPUP Proof era
Conway GovState era
_ = forall a. Default a => a
def @(ShelleyGovState era)

putPPUP :: forall era. Proof era -> ShelleyGovState era -> Gov.GovState era
putPPUP :: forall era. Proof era -> ShelleyGovState era -> GovState era
putPPUP Proof era
Shelley ShelleyGovState era
x = GovState era
ShelleyGovState era
x
putPPUP Proof era
Allegra ShelleyGovState era
x = GovState era
ShelleyGovState era
x
putPPUP Proof era
Mary ShelleyGovState era
x = GovState era
ShelleyGovState era
x
putPPUP Proof era
Alonzo ShelleyGovState era
x = GovState era
ShelleyGovState era
x
putPPUP Proof era
Babbage ShelleyGovState era
x = GovState era
ShelleyGovState era
x
putPPUP Proof era
Conway ShelleyGovState era
_ = forall era. EraGov era => GovState era
Gov.emptyGovState @era

-- ================
liftUTxO :: Map TxIn (TxOutF era) -> UTxO era
liftUTxO :: forall era. Map TxIn (TxOutF era) -> UTxO era
liftUTxO Map TxIn (TxOutF era)
m = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO ((TxOutF era -> TxOut era)
-> Map TxIn (TxOutF era) -> Map TxIn (TxOut era)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TxOutF era -> TxOut era
forall era. TxOutF era -> TxOut era
unTxOut Map TxIn (TxOutF era)
m)

instance Show (TxOutF era) where
  show :: TxOutF era -> String
show (TxOutF Proof era
p TxOut era
t) = PDoc -> String
forall a. Show a => a -> String
show ((Reflect era => Proof era -> TxOut era -> PDoc)
-> Proof era -> TxOut era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> TxOut era -> PDoc
Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
p TxOut era
t :: PDoc)

instance Show (ValueF era) where
  show :: ValueF era -> String
show (ValueF Proof era
p Value era
t) = PDoc -> String
forall a. Show a => a -> String
show (Proof era -> Value era -> PDoc
forall era. Proof era -> Value era -> PDoc
pcVal Proof era
p Value era
t)

instance Show (PParamsF era) where
  show :: PParamsF era -> String
show (PParamsF Proof era
_ PParams era
_) = String
"PParamsF ..."

instance Show (PParamsUpdateF era) where
  show :: PParamsUpdateF era -> String
show (PParamsUpdateF Proof era
_ PParamsUpdate era
_) = String
"PParamsUpdateF ..."

instance Show (ProposedPPUpdatesF era) where
  show :: ProposedPPUpdatesF era -> String
show (ProposedPPUpdatesF Proof era
_ ProposedPPUpdates era
_) = String
"ProposedPPUdatesF ..."

genValue :: Proof era -> Gen (ValueF era)
genValue :: forall era. Proof era -> Gen (ValueF era)
genValue Proof era
p = case Proof era
p of
  Proof era
Shelley -> Proof era -> Value era -> ValueF era
forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (Coin -> ValueF era) -> Gen Coin -> Gen (ValueF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> Proof era -> Value era -> ValueF era
forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (Coin -> ValueF era) -> Gen Coin -> Gen (ValueF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> Proof era -> Value era -> ValueF era
forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (MaryValue -> ValueF era) -> Gen MaryValue -> Gen (ValueF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MaryValue
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> Proof era -> Value era -> ValueF era
forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (MaryValue -> ValueF era) -> Gen MaryValue -> Gen (ValueF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MaryValue
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Proof era -> Value era -> ValueF era
forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (MaryValue -> ValueF era) -> Gen MaryValue -> Gen (ValueF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MaryValue
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> Proof era -> Value era -> ValueF era
forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (MaryValue -> ValueF era) -> Gen MaryValue -> Gen (ValueF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MaryValue
forall a. Arbitrary a => Gen a
arbitrary

genTxOut :: Proof era -> Gen (TxOutF era)
genTxOut :: forall era. Proof era -> Gen (TxOutF era)
genTxOut Proof era
p = do
  Integer
n <- [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
2, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
100)), (Int
1, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
101, Integer
1000))]
  (Reflect era => Proof era -> Coin -> Gen (TxOutF era))
-> Proof era -> Coin -> Gen (TxOutF era)
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> Coin -> Gen (TxOutF era)
Proof era -> Coin -> Gen (TxOutF era)
forall era. Reflect era => Proof era -> Coin -> Gen (TxOutF era)
genTxOutX Proof era
p (Integer -> Coin
Coin Integer
n)

genPParams :: Proof era -> Gen (PParamsF era)
genPParams :: forall era. Proof era -> Gen (PParamsF era)
genPParams Proof era
p = case Proof era
p of
  Proof era
Shelley -> Proof era -> PParams era -> PParamsF era
forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p (PParams era -> PParamsF era)
-> Gen (PParams era) -> Gen (PParamsF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> Proof era -> PParams era -> PParamsF era
forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p (PParams era -> PParamsF era)
-> Gen (PParams era) -> Gen (PParamsF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> Proof era -> PParams era -> PParamsF era
forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p (PParams era -> PParamsF era)
-> Gen (PParams era) -> Gen (PParamsF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> Proof era -> PParams era -> PParamsF era
forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p (PParams era -> PParamsF era)
-> Gen (PParams era) -> Gen (PParamsF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Proof era -> PParams era -> PParamsF era
forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p (PParams era -> PParamsF era)
-> Gen (PParams era) -> Gen (PParamsF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> Proof era -> PParams era -> PParamsF era
forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p (PParams era -> PParamsF era)
-> Gen (PParams era) -> Gen (PParamsF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary

genFuturePParams :: Proof era -> Gen (FuturePParams era)
genFuturePParams :: forall era. Proof era -> Gen (FuturePParams era)
genFuturePParams Proof era
p =
  [(Int, Gen (FuturePParams era))] -> Gen (FuturePParams era)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
2, FuturePParams era -> Gen (FuturePParams era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FuturePParams era
forall era. FuturePParams era
NoPParamsUpdate)
    , (Int
2, PParams era -> FuturePParams era
forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate (PParams era -> FuturePParams era)
-> (PParamsF era -> PParams era)
-> PParamsF era
-> FuturePParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParamsF era -> PParams era
forall era. PParamsF era -> PParams era
unPParams (PParamsF era -> FuturePParams era)
-> Gen (PParamsF era) -> Gen (FuturePParams era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proof era -> Gen (PParamsF era)
forall era. Proof era -> Gen (PParamsF era)
genPParams Proof era
p)
    , (Int
1, FuturePParams era -> Gen (FuturePParams era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PParams era) -> FuturePParams era
forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate Maybe (PParams era)
forall a. Maybe a
Nothing))
    , (Int
1, Maybe (PParams era) -> FuturePParams era
forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate (Maybe (PParams era) -> FuturePParams era)
-> (PParamsF era -> Maybe (PParams era))
-> PParamsF era
-> FuturePParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams era -> Maybe (PParams era)
forall a. a -> Maybe a
Just (PParams era -> Maybe (PParams era))
-> (PParamsF era -> PParams era)
-> PParamsF era
-> Maybe (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParamsF era -> PParams era
forall era. PParamsF era -> PParams era
unPParams (PParamsF era -> FuturePParams era)
-> Gen (PParamsF era) -> Gen (FuturePParams era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proof era -> Gen (PParamsF era)
forall era. Proof era -> Gen (PParamsF era)
genPParams Proof era
p)
    ]

genPParamsUpdate :: Proof era -> Gen (PParamsUpdateF era)
genPParamsUpdate :: forall era. Proof era -> Gen (PParamsUpdateF era)
genPParamsUpdate Proof era
p = case Proof era
p of
  Proof era
Shelley -> Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p (PParamsUpdate era -> PParamsUpdateF era)
-> Gen (PParamsUpdate era) -> Gen (PParamsUpdateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constants -> PParams era -> Gen (PParamsUpdate era)
forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
Constants -> PParams era -> Gen (PParamsUpdate era)
genShelleyPParamsUpdate Constants
defaultConstants PParams era
forall a. Default a => a
def
  Proof era
Allegra -> Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p (PParamsUpdate era -> PParamsUpdateF era)
-> Gen (PParamsUpdate era) -> Gen (PParamsUpdateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constants -> PParams era -> Gen (PParamsUpdate era)
forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
Constants -> PParams era -> Gen (PParamsUpdate era)
genShelleyPParamsUpdate Constants
defaultConstants PParams era
forall a. Default a => a
def
  Proof era
Mary -> Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p (PParamsUpdate era -> PParamsUpdateF era)
-> Gen (PParamsUpdate era) -> Gen (PParamsUpdateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constants -> PParams era -> Gen (PParamsUpdate era)
forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
Constants -> PParams era -> Gen (PParamsUpdate era)
genShelleyPParamsUpdate Constants
defaultConstants PParams era
forall a. Default a => a
def
  Proof era
Alonzo -> Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p (PParamsUpdate era -> PParamsUpdateF era)
-> Gen (PParamsUpdate era) -> Gen (PParamsUpdateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParamsUpdate era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p (PParamsUpdate era -> PParamsUpdateF era)
-> Gen (PParamsUpdate era) -> Gen (PParamsUpdateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParamsUpdate era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> Proof era -> PParamsUpdate era -> PParamsUpdateF era
forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p (PParamsUpdate era -> PParamsUpdateF era)
-> Gen (PParamsUpdate era) -> Gen (PParamsUpdateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParamsUpdate era)
forall a. Arbitrary a => Gen a
arbitrary

genProposedPPUpdates :: Proof era -> Gen (ProposedPPUpdatesF era)
genProposedPPUpdates :: forall era. Proof era -> Gen (ProposedPPUpdatesF era)
genProposedPPUpdates Proof era
p = case Proof era
p of
  Proof era
Shelley -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p (ProposedPPUpdates era -> ProposedPPUpdatesF era)
-> (Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdatesF era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
PP.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdatesF era)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (ProposedPPUpdatesF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p (ProposedPPUpdates era -> ProposedPPUpdatesF era)
-> (Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdatesF era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
PP.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdatesF era)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (ProposedPPUpdatesF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p (ProposedPPUpdates era -> ProposedPPUpdatesF era)
-> (Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdatesF era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
PP.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdatesF era)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (ProposedPPUpdatesF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p (ProposedPPUpdates era -> ProposedPPUpdatesF era)
-> (Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdatesF era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
PP.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdatesF era)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (ProposedPPUpdatesF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p (ProposedPPUpdates era -> ProposedPPUpdatesF era)
-> (Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdatesF era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
PP.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdatesF era)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (ProposedPPUpdatesF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
forall era.
Proof era -> ProposedPPUpdates era -> ProposedPPUpdatesF era
ProposedPPUpdatesF Proof era
p (ProposedPPUpdates era -> ProposedPPUpdatesF era)
-> (Map (KeyHash 'Genesis) (PParamsUpdate era)
    -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdatesF era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
PP.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdatesF era)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (ProposedPPUpdatesF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. Arbitrary a => Gen a
arbitrary

genCertState :: forall era. Reflect era => Gen (CertStateF era)
genCertState :: forall era. Reflect era => Gen (CertStateF era)
genCertState = case forall era. Reflect era => Proof era
reify @era of
  p :: Proof era
p@Proof era
Shelley -> Proof era -> CertState era -> CertStateF era
forall era. Proof era -> CertState era -> CertStateF era
CertStateF Proof era
p (ShelleyCertState ShelleyEra -> CertStateF era)
-> Gen (ShelleyCertState ShelleyEra) -> Gen (CertStateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyCertState ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary
  p :: Proof era
p@Proof era
Allegra -> Proof era -> CertState era -> CertStateF era
forall era. Proof era -> CertState era -> CertStateF era
CertStateF Proof era
p (ShelleyCertState AllegraEra -> CertStateF era)
-> Gen (ShelleyCertState AllegraEra) -> Gen (CertStateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyCertState AllegraEra)
forall a. Arbitrary a => Gen a
arbitrary
  p :: Proof era
p@Proof era
Mary -> Proof era -> CertState era -> CertStateF era
forall era. Proof era -> CertState era -> CertStateF era
CertStateF Proof era
p (ShelleyCertState MaryEra -> CertStateF era)
-> Gen (ShelleyCertState MaryEra) -> Gen (CertStateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyCertState MaryEra)
forall a. Arbitrary a => Gen a
arbitrary
  p :: Proof era
p@Proof era
Alonzo -> Proof era -> CertState era -> CertStateF era
forall era. Proof era -> CertState era -> CertStateF era
CertStateF Proof era
p (ShelleyCertState AlonzoEra -> CertStateF era)
-> Gen (ShelleyCertState AlonzoEra) -> Gen (CertStateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyCertState AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary
  p :: Proof era
p@Proof era
Babbage -> Proof era -> CertState era -> CertStateF era
forall era. Proof era -> CertState era -> CertStateF era
CertStateF Proof era
p (ShelleyCertState BabbageEra -> CertStateF era)
-> Gen (ShelleyCertState BabbageEra) -> Gen (CertStateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyCertState BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary
  p :: Proof era
p@Proof era
Conway -> Proof era -> CertState era -> CertStateF era
forall era. Proof era -> CertState era -> CertStateF era
CertStateF Proof era
p (ConwayCertState ConwayEra -> CertStateF era)
-> Gen (ConwayCertState ConwayEra) -> Gen (CertStateF era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ConwayCertState ConwayEra)
forall a. Arbitrary a => Gen a
arbitrary

genGovState :: Proof era -> Gen (GovState era)
genGovState :: forall era. Proof era -> Gen (GovState era)
genGovState Proof era
p = case Proof era
p of
  Proof era
Shelley -> Proof era -> GovState era -> GovState era
forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p (ShelleyGovState ShelleyEra -> GovState era)
-> Gen (ShelleyGovState ShelleyEra) -> Gen (GovState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyGovState ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> Proof era -> GovState era -> GovState era
forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p (ShelleyGovState AllegraEra -> GovState era)
-> Gen (ShelleyGovState AllegraEra) -> Gen (GovState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyGovState AllegraEra)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> Proof era -> GovState era -> GovState era
forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p (ShelleyGovState MaryEra -> GovState era)
-> Gen (ShelleyGovState MaryEra) -> Gen (GovState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyGovState MaryEra)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> Proof era -> GovState era -> GovState era
forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p (ShelleyGovState AlonzoEra -> GovState era)
-> Gen (ShelleyGovState AlonzoEra) -> Gen (GovState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyGovState AlonzoEra)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Proof era -> GovState era -> GovState era
forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p (ShelleyGovState BabbageEra -> GovState era)
-> Gen (ShelleyGovState BabbageEra) -> Gen (GovState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyGovState BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> GovState era -> Gen (GovState era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovState era -> Gen (GovState era))
-> GovState era -> Gen (GovState era)
forall a b. (a -> b) -> a -> b
$ Proof era -> GovState era -> GovState era
forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
GovState ConwayEra
forall era. EraGov era => GovState era
Gov.emptyGovState

genUTxO :: Proof era -> Gen (UTxO era)
genUTxO :: forall era. Proof era -> Gen (UTxO era)
genUTxO Proof era
p = case Proof era
p of
  Proof era
Shelley -> Gen (UTxO era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Allegra -> Gen (UTxO era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Mary -> Gen (UTxO era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Alonzo -> Gen (UTxO era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Babbage -> Gen (UTxO era)
forall a. Arbitrary a => Gen a
arbitrary
  Proof era
Conway -> Gen (UTxO era)
forall a. Arbitrary a => Gen a
arbitrary

-- ========================

data ScriptsNeededF era where
  ScriptsNeededF :: Proof era -> ScriptsNeeded era -> ScriptsNeededF era

unScriptsNeededF :: ScriptsNeededF era -> ScriptsNeeded era
unScriptsNeededF :: forall era. ScriptsNeededF era -> ScriptsNeeded era
unScriptsNeededF (ScriptsNeededF Proof era
_ ScriptsNeeded era
v) = ScriptsNeeded era
v

instance Show (ScriptsNeededF era) where
  show :: ScriptsNeededF era -> String
show (ScriptsNeededF Proof era
p ScriptsNeeded era
t) = (Reflect era => Proof era -> String) -> Proof era -> String
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect (\Proof era
_ -> PDoc -> String
forall a. Show a => a -> String
show (Proof era -> ScriptsNeeded era -> PDoc
forall era. Reflect era => Proof era -> ScriptsNeeded era -> PDoc
pcScriptsNeeded Proof era
p ScriptsNeeded era
t)) Proof era
p

-- ========================

data ScriptF era where
  ScriptF :: Proof era -> Script era -> ScriptF era

unScriptF :: ScriptF era -> Script era
unScriptF :: forall era. ScriptF era -> Script era
unScriptF (ScriptF Proof era
_ Script era
v) = Script era
v

instance PrettyA (ScriptF era) where
  prettyA :: ScriptF era -> PDoc
prettyA (ScriptF Proof era
p Script era
x) = (Reflect era => Proof era -> Script era -> PDoc)
-> Proof era -> Script era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> Script era -> PDoc
Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
p Script era
x

instance Show (ScriptF era) where
  show :: ScriptF era -> String
show (ScriptF Proof era
p Script era
t) = PDoc -> String
forall a. Show a => a -> String
show (((Reflect era => Proof era -> Script era -> PDoc)
-> Proof era -> Script era -> PDoc
forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era => Proof era -> Script era -> PDoc
Proof era -> Script era -> PDoc
forall era. Reflect era => Proof era -> Script era -> PDoc
pcScript Proof era
p Script era
t) :: PDoc)

instance Eq (ScriptF era) where
  (ScriptF Proof era
Shelley Script era
x) == :: ScriptF era -> ScriptF era -> Bool
== (ScriptF Proof era
Shelley Script era
y) = Script era
MultiSig ShelleyEra
x MultiSig ShelleyEra -> MultiSig ShelleyEra -> Bool
forall a. Eq a => a -> a -> Bool
== Script era
MultiSig ShelleyEra
y
  (ScriptF Proof era
Allegra Script era
x) == (ScriptF Proof era
Allegra Script era
y) = Timelock AllegraEra
Script era
x Timelock AllegraEra -> Timelock AllegraEra -> Bool
forall a. Eq a => a -> a -> Bool
== Timelock AllegraEra
Script era
y
  (ScriptF Proof era
Mary Script era
x) == (ScriptF Proof era
Mary Script era
y) = Timelock MaryEra
Script era
x Timelock MaryEra -> Timelock MaryEra -> Bool
forall a. Eq a => a -> a -> Bool
== Timelock MaryEra
Script era
y
  (ScriptF Proof era
Alonzo Script era
x) == (ScriptF Proof era
Alonzo Script era
y) = Script era
AlonzoScript AlonzoEra
x AlonzoScript AlonzoEra -> AlonzoScript AlonzoEra -> Bool
forall a. Eq a => a -> a -> Bool
== Script era
AlonzoScript AlonzoEra
y
  (ScriptF Proof era
Babbage Script era
x) == (ScriptF Proof era
Babbage Script era
y) = Script era
AlonzoScript BabbageEra
x AlonzoScript BabbageEra -> AlonzoScript BabbageEra -> Bool
forall a. Eq a => a -> a -> Bool
== Script era
AlonzoScript BabbageEra
y
  (ScriptF Proof era
Conway Script era
x) == (ScriptF Proof era
Conway Script era
y) = Script era
AlonzoScript ConwayEra
x AlonzoScript ConwayEra -> AlonzoScript ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
== Script era
AlonzoScript ConwayEra
y

genScriptF :: Proof era -> Gen (ScriptF era)
genScriptF :: forall era. Proof era -> Gen (ScriptF era)
genScriptF Proof era
proof = do
  PlutusPurposeTag
tag <- [PlutusPurposeTag] -> Gen PlutusPurposeTag
forall a. HasCallStack => [a] -> Gen a
elements ([PlutusPurposeTag] -> Gen PlutusPurposeTag)
-> [PlutusPurposeTag] -> Gen PlutusPurposeTag
forall a b. (a -> b) -> a -> b
$ Proof era -> [PlutusPurposeTag]
forall era. Proof era -> [PlutusPurposeTag]
plutusPurposeTags Proof era
proof
  ValidityInterval
vi <- Gen ValidityInterval
forall a. Arbitrary a => Gen a
arbitrary
  Map (KeyHash 'Witness) (KeyPair 'Witness)
m <- [(KeyHash 'Witness, KeyPair 'Witness)]
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'Witness, KeyPair 'Witness)]
 -> Map (KeyHash 'Witness) (KeyPair 'Witness))
-> Gen [(KeyHash 'Witness, KeyPair 'Witness)]
-> Gen (Map (KeyHash 'Witness) (KeyPair 'Witness))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Gen (KeyHash 'Witness, KeyPair 'Witness)
-> Gen [(KeyHash 'Witness, KeyPair 'Witness)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
5 Gen (KeyHash 'Witness, KeyPair 'Witness)
forall a. Arbitrary a => Gen a
arbitrary
  Script era
corescript <- Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
forall era.
Proof era
-> PlutusPurposeTag
-> Map (KeyHash 'Witness) (KeyPair 'Witness)
-> ValidityInterval
-> Gen (Script era)
genCoreScript Proof era
proof PlutusPurposeTag
tag Map (KeyHash 'Witness) (KeyPair 'Witness)
m ValidityInterval
vi
  ScriptF era -> Gen (ScriptF era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> Script era -> ScriptF era
forall era. Proof era -> Script era -> ScriptF era
ScriptF Proof era
proof Script era
corescript)

-- ==========================================================================
-- A Single Partition function on Integer, we use to do all partitions by
-- using wrapper functions.
-- ==========================================================================

zeroCount :: Show a => [Char] -> a -> [Char]
zeroCount :: forall a. Show a => String -> a -> String
zeroCount String
fname a
total =
  String
fname
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" called with count=(0) and total=("
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
total
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") \n"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Probably due to (SumsTo comparison "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
total
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [SumMap x]) where 'x' is the emptyset.\n"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Try adding (Sized (Range 1 m) (Dom x)) constraint to force 'x' to have at least 1 element"

legalCallPartition :: [String] -> String -> Integer -> Int -> Integer -> Maybe [String]
legalCallPartition :: [String] -> String -> Integer -> Int -> Integer -> Maybe [String]
legalCallPartition [String]
msgs String
typname Integer
smallest Int
size Integer
total
  | Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Integer
smallest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 =
      [String] -> Maybe [String]
forall a. a -> Maybe a
Just
        ( [ String
"partition at type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typname
          , String
"smallest="
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
smallest
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", size="
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", total="
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
total
          ]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
msgs
        )
  | Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
total Bool -> Bool -> Bool
&& Integer
smallest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 =
      [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$
        ( String
"Can't partition "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
total
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" positive pieces at type "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typname
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (smallest = "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
smallest
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        )
          String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs
  | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 =
      [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$
        ( String
"Can only make a partition of a positive number of pieces: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", total: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
total
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", smallest: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
smallest
        )
          String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs
  | Integer
smallest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
smallest Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
total =
      [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$
        ( String
"Can't partition "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
total
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" pieces, each (>= "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
smallest
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        )
          String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs
  | Integer
total Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 Bool -> Bool -> Bool
&& Integer
smallest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 =
      [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$
        ( String
"Total ("
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
total
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") must be positive when smallest("
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
smallest
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") is positive."
        )
          String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs
  | Bool
True = Maybe [String]
forall a. Maybe a
Nothing

-- | Generate a list of length 'size' that sums to 'total', where the minimum element is (>= 'smallest')
integerPartition :: [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition :: [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition [String]
msgs String
typname Integer
smallest Int
size Integer
total
  | Integer
total Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Integer
smallest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = [Integer] -> Gen [Integer]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate Int
size Integer
0)
  | Bool
True = case [String] -> String -> Integer -> Int -> Integer -> Maybe [String]
legalCallPartition [String]
msgs String
typname Integer
smallest Int
size Integer
total of
      Just (String
x : [String]
xs) -> String -> [String] -> Gen [Integer]
forall a. HasCallStack => String -> [String] -> a
errorMess String
x [String]
xs
      Just [] -> String -> [String] -> Gen [Integer]
forall a. HasCallStack => String -> [String] -> a
errorMess String
"legalCallPartition returns []" []
      Maybe [String]
Nothing ->
        let mean :: Integer
mean = Integer
total Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            go :: Integer -> Integer -> Gen [Integer]
go Integer
1 Integer
total1
              | Integer
total1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 Bool -> Bool -> Bool
&& Integer
smallest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 =
                  String -> [String] -> Gen [Integer]
forall a. HasCallStack => String -> [String] -> a
errorMess (String
"Ran out of choices(2), total went negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
total1) [String]
msgs
              | Bool
otherwise = [Integer] -> Gen [Integer]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Integer
total1]
            go Integer
2 Integer
total1 = do
              Integer
z <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
smallest, Integer
total1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
              [Integer] -> Gen [Integer]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Integer
z, Integer
total1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
z]
            go Integer
size1 Integer
total1 = do
              let hi :: Integer
hi =
                    Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min
                      (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 Integer
mean)
                      (Integer
total1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
size1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
              Integer
x <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
smallest, Integer
hi)
              [Integer]
xs <- Integer -> Integer -> Gen [Integer]
go (Integer
size1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (Integer
total1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x)
              [Integer] -> Gen [Integer]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
x Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
xs)
         in do
              [Integer]
ws <- Integer -> Integer -> Gen [Integer]
go (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) Integer
total
              [Integer] -> Gen [Integer]
forall a. [a] -> Gen [a]
shuffle [Integer]
ws

partitionRational :: Rational -> [String] -> Int -> Rational -> Gen [Rational]
partitionRational :: Ratio Integer
-> [String] -> Int -> Ratio Integer -> Gen [Ratio Integer]
partitionRational Ratio Integer
smallest [String]
msgs Int
size Ratio Integer
total = do
  let scale :: Integer
scale = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm (Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
smallest) (Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
total)
      iSmallest :: Integer
iSmallest = Ratio Integer -> Integer
forall a. Ratio a -> a
numerator (Ratio Integer
smallest Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* (Integer
scale Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1))
      iTotal :: Integer
iTotal = Ratio Integer -> Integer
forall a. Ratio a -> a
numerator (Ratio Integer
total Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* (Integer
scale Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1))
  [Integer]
is <- [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition [String]
msgs (String
"Rational*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
scale) Integer
iSmallest Int
size Integer
iTotal
  [Ratio Integer] -> Gen [Ratio Integer]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Integer -> Ratio Integer) -> [Integer] -> [Ratio Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> Integer
i Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
scale) [Integer]
is)

partitionCoin :: Coin -> [String] -> Int -> Coin -> Gen [Coin]
partitionCoin :: Coin -> [String] -> Int -> Coin -> Gen [Coin]
partitionCoin (Coin Integer
small) [String]
msgs Int
n (Coin Integer
total) =
  (Integer -> Coin) -> [Integer] -> [Coin]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Coin
Coin ([Integer] -> [Coin]) -> Gen [Integer] -> Gen [Coin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition [String]
msgs String
"Coin" Integer
small Int
n Integer
total

partitionDeltaCoin :: DeltaCoin -> [String] -> Int -> DeltaCoin -> Gen [DeltaCoin]
partitionDeltaCoin :: DeltaCoin -> [String] -> Int -> DeltaCoin -> Gen [DeltaCoin]
partitionDeltaCoin (DeltaCoin Integer
small) [String]
msgs Int
n (DeltaCoin Integer
total) =
  (Integer -> DeltaCoin) -> [Integer] -> [DeltaCoin]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> DeltaCoin
DeltaCoin ([Integer] -> [DeltaCoin]) -> Gen [Integer] -> Gen [DeltaCoin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition [String]
msgs String
"DeltaCoin" Integer
small Int
n Integer
total

partitionInt :: Int -> [String] -> Int -> Int -> Gen [Int]
partitionInt :: Int -> [String] -> Int -> Int -> Gen [Int]
partitionInt Int
small [String]
msgs Int
n Int
total =
  (Integer -> Int) -> [Integer] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Int]) -> Gen [Integer] -> Gen [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition [String]
msgs String
"Int" (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
small) Int
n (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total)

partitionWord64 :: Word64 -> [String] -> Int -> Word64 -> Gen [Word64]
partitionWord64 :: Word64 -> [String] -> Int -> Word64 -> Gen [Word64]
partitionWord64 Word64
small [String]
msgs Int
n Word64
total =
  (Integer -> Word64) -> [Integer] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Word64]) -> Gen [Integer] -> Gen [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition [String]
msgs String
"Word64" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
small) Int
n (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
total)

partitionNatural :: Natural -> [String] -> Int -> Natural -> Gen [Natural]
partitionNatural :: Natural -> [String] -> Int -> Natural -> Gen [Natural]
partitionNatural Natural
small [String]
msgs Int
n Natural
total =
  (Integer -> Natural) -> [Integer] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Natural]) -> Gen [Integer] -> Gen [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> String -> Integer -> Int -> Integer -> Gen [Integer]
integerPartition [String]
msgs String
"Natural" (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
small) Int
n (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
total)

-- =======================================================

-- | Translate (s,cond,n), into a Size which
--   specifies the Int range on which the OrdCond is True.
--   The triple (s, EQL, 2) denotes s = 2
--              (s, LTH, 7) denotes s < 7
--              (s, GTH, 5) denotes s > 5 ...
ordCondToSize :: forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize :: forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
_label, OrdCond
cond, a
n) = case OrdCond
cond of
  OrdCond
EQL -> Int -> Size
SzExact (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ a -> Int
forall x. Adds x => x -> Int
toI a
n
  OrdCond
LTH -> Int -> Size
SzMost (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ forall x. Adds x => Int -> Int
decreaseBy1 @a (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ a -> Int
forall x. Adds x => x -> Int
toI a
n
  OrdCond
LTE -> Int -> Size
SzMost (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ a -> Int
forall x. Adds x => x -> Int
toI a
n
  OrdCond
GTH -> Int -> Size
SzLeast (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ forall x. Adds x => Int -> Int
increaseBy1 @a (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ a -> Int
forall x. Adds x => x -> Int
toI a
n
  OrdCond
GTE -> Int -> Size
SzLeast (Int -> Size) -> Int -> Size
forall a b. (a -> b) -> a -> b
$ a -> Int
forall x. Adds x => x -> Int
toI a
n

-- Translate some thing like [SumsTo _ x <= 4 + 6 + 9] where the variable 'x' is on the left
varOnLeft :: Adds a => String -> OrdCond -> a -> AddsSpec c
varOnLeft :: forall a c. Adds a => String -> OrdCond -> a -> AddsSpec c
varOnLeft String
x OrdCond
cond a
n = String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
x (String -> OrdCond -> a -> Size
forall a. Adds a => String -> OrdCond -> a -> Size
varOnLeftSize String
x OrdCond
cond a
n)

varOnLeftSize :: Adds a => String -> OrdCond -> a -> Size
varOnLeftSize :: forall a. Adds a => String -> OrdCond -> a -> Size
varOnLeftSize String
x OrdCond
cond a
n = (String, OrdCond, a) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
x, OrdCond
cond, a
n)

-- Translate some thing like [SumsTo c 8 < 2 + x + 3] where the variable 'x' is on the right
varOnRight :: Adds a => [String] -> a -> OrdCond -> a -> String -> AddsSpec c
varOnRight :: forall a c.
Adds a =>
[String] -> a -> OrdCond -> a -> String -> AddsSpec c
varOnRight [String]
_ a
lhs OrdCond
LTH a
rhs String
s
  | a -> Int
forall x. Adds x => x -> Int
toI a
rhs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Int
forall x. Adds x => x -> Int
toI a
lhs -- When this holds the only constraint on the var 's' is that its is (>= 0)
    =
      String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
s (Int -> Size
SzLeast Int
0)
varOnRight [String]
msgs a
lhs OrdCond
cond a
rhs String
s =
  String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize
    String
s
    ( [String] -> a -> OrdCond -> a -> String -> Size
forall a. Adds a => [String] -> a -> OrdCond -> a -> String -> Size
varOnRightSize
        ( ( String
"varOnRight @"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
lhs)
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
lhs
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ OrdCond -> String
forall a. Show a => a -> String
show OrdCond
cond
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
rhs
          )
            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs
        )
        a
lhs
        OrdCond
cond
        a
rhs
        String
s
    )

varOnRightSize :: Adds a => [String] -> a -> OrdCond -> a -> String -> Size
varOnRightSize :: forall a. Adds a => [String] -> a -> OrdCond -> a -> String -> Size
varOnRightSize [String]
msgs a
n OrdCond
cond a
m String
s =
  if Bool -> Bool
not (a -> Bool
forall x. Adds x => x -> Bool
supportsNegative a
n) Bool -> Bool -> Bool
&& a -> Int
forall x. Adds x => x -> Int
toI a
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall x. Adds x => x -> Int
toI a
m
    then -- if the lhs 'n' is less than the rhs 'm', then the var 's' must be 0 or greater
      Int -> Size
SzLeast Int
0
    else
      (String, OrdCond, a) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize
        ( String
s
        , OrdCond -> OrdCond
reverseOrdCond OrdCond
cond
        , [String] -> a -> a -> a
forall x. Adds x => [String] -> x -> x -> x
minus
            ((String
"varOnRightSize " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ OrdCond -> String
forall a. Show a => a -> String
show OrdCond
cond String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs)
            a
n
            a
m
        )

-- Translate some thing like [SumsTo (Negate x) <= 4 + 6 + 9] where the variable 'x'
-- is on the left, and we want to produce its negation.
varOnLeftNeg :: Adds a => String -> OrdCond -> a -> AddsSpec c
varOnLeftNeg :: forall a c. Adds a => String -> OrdCond -> a -> AddsSpec c
varOnLeftNeg String
s OrdCond
cond a
n = String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
s (Size -> Size
negateSize ((String, OrdCond, a) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
s, OrdCond
cond, a
n)))

-- Translate some thing like [SumsTo 8 < 2 + (Negate x) + 3] where the
-- variable 'x' is on the right, and we want to produce its negation.
varOnRightNeg :: Adds a => a -> OrdCond -> a -> String -> AddsSpec c
varOnRightNeg :: forall a c. Adds a => a -> OrdCond -> a -> String -> AddsSpec c
varOnRightNeg a
n OrdCond
cond a
m String
s =
  String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize
    String
s
    (Size -> Size
negateSize ((String, OrdCond, a) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
s, OrdCond -> OrdCond
reverseOrdCond OrdCond
cond, [String] -> a -> a -> a
forall x. Adds x => [String] -> x -> x -> x
minus [String
"varOnRightNeg", String
s, a -> String
forall a. Show a => a -> String
show a
m] a
n a
m)))

-- | This function `reverseOrdCond` has been defined to handle the Pred SumsTo when the
--   variable is on the right-hand-side (rhs) of the OrdCond operator. In order to do that
--   we must multiply both sides of the inequality by (-1). For example consider
--   [SumsTo (DeltaCoin 1) ▵₳ -2 > ∑ ▵₳ -1 + x]
--                 Note variable x on the rhs ^
--    To solve we subtract 'x' from both sides, and add '▵₳ -2' from bothsides
--    getting      (-x) > ∑  (▵₳ -1) + (▵₳ -2)
--    reduced to   (-x) > ∑  (▵₳ -3)
--    to solve we must multiply both sides by (-1)
--                 x ?? ∑  (▵₳ 3)
-- What operator do we replace ?? by to make the original (▵₳ -2 > ∑ ▵₳ -1 + x) True?
-- The change in the operator is called "reversing" the operator. See
-- https://www.mathsisfun.com/algebra/inequality-solving.html for one explantion.
reverseOrdCond :: OrdCond -> OrdCond
reverseOrdCond :: OrdCond -> OrdCond
reverseOrdCond OrdCond
EQL = OrdCond
EQL
reverseOrdCond OrdCond
LTH = OrdCond
GTH
reverseOrdCond OrdCond
LTE = OrdCond
GTE
reverseOrdCond OrdCond
GTH = OrdCond
LTH
reverseOrdCond OrdCond
GTE = OrdCond
LTE

-- =========================================================================
-- OrdCond
-- x <= y
--   ^     paramerterize over the condition
--
-- EQL = (==), LTH = (<), LTE = (<=), GTH = (>), GTE = (>=)
-- =========================================================================

-- | First order representation of the Ord comparisons
data OrdCond = EQL | LTH | LTE | GTH | GTE
  deriving (OrdCond -> OrdCond -> Bool
(OrdCond -> OrdCond -> Bool)
-> (OrdCond -> OrdCond -> Bool) -> Eq OrdCond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrdCond -> OrdCond -> Bool
== :: OrdCond -> OrdCond -> Bool
$c/= :: OrdCond -> OrdCond -> Bool
/= :: OrdCond -> OrdCond -> Bool
Eq)

instance Show OrdCond where
  show :: OrdCond -> String
show OrdCond
EQL = String
" = ∑ "
  show OrdCond
LTH = String
" < ∑ "
  show OrdCond
LTE = String
" <= ∑ "
  show OrdCond
GTH = String
" > ∑ "
  show OrdCond
GTE = String
" >= ∑ "

runOrdCond :: Ord c => OrdCond -> c -> c -> Bool
runOrdCond :: forall c. Ord c => OrdCond -> c -> c -> Bool
runOrdCond OrdCond
EQL c
x c
y = c
x c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
y
runOrdCond OrdCond
LTH c
x c
y = c
x c -> c -> Bool
forall a. Ord a => a -> a -> Bool
< c
y
runOrdCond OrdCond
LTE c
x c
y = c
x c -> c -> Bool
forall a. Ord a => a -> a -> Bool
<= c
y
runOrdCond OrdCond
GTH c
x c
y = c
x c -> c -> Bool
forall a. Ord a => a -> a -> Bool
> c
y
runOrdCond OrdCond
GTE c
x c
y = c
x c -> c -> Bool
forall a. Ord a => a -> a -> Bool
>= c
y

-- =========================================================================

-- | A specification of summation. like: lhs = ∑ rhs
--   The idea is that the 'rhs' can contain multiple terms: rhs = ∑ r1 + r2 + r3
--   Other example conditions:  (lhs < ∑ rhs), and (lhs >= ∑ rhs)
--   The invariant is that only a single variable appears in the summation.
--   It can appear on either side. If it appears in the 'rhs' then there
--   may be other, constant terms, in the rhs:  7 = ∑ 3 + v + 9
--   We always do the sums and solving at type Int, and cast back and forth to
--   accommodate other types with (Adds c) instances, using the methods 'fromI" and 'toI'
--   This allows the instance to deal with special conditions.
--   There are two (non-failure) possibilities 1) Var on the left, 2) Var on the right
--   We supply functions
--      varOnLeft  :: String -> OrdCond -> Integer -> AddsSpec c
--                SumsTo _ x <= 4 + 6 + 9 ===> (varOnLeft x LTE 19) == (AddsSpecSize x (AtMost 19))
--      varOnRight :: Integer -> OrdCond -> Integer -> String -> AddsSpec c
--                SumsTo _ 8 < 2 + x + 3 ===> (varOnRight 8 LTH 5 x) == (AddsSpecSize x (AtLeast 4))
--   But internally we store the information as a String and a Size (I.e. a range of Int)
data AddsSpec c where
  AddsSpecSize ::
    -- | name
    String ->
    -- | total (range like (4 .. 12))
    Size ->
    AddsSpec c
  AddsSpecAny :: AddsSpec c
  AddsSpecNever :: [String] -> AddsSpec c

instance LiftT (AddsSpec c) where
  liftT :: AddsSpec c -> Typed (AddsSpec c)
liftT (AddsSpecNever [String]
xs) = [String] -> Typed (AddsSpec c)
forall a. [String] -> Typed a
failT [String]
xs
  liftT AddsSpec c
x = AddsSpec c -> Typed (AddsSpec c)
forall a. a -> Typed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddsSpec c
x
  dropT :: Typed (AddsSpec c) -> AddsSpec c
dropT (Typed (Left [String]
s)) = [String] -> AddsSpec c
forall c. [String] -> AddsSpec c
AddsSpecNever [String]
s
  dropT (Typed (Right AddsSpec c
x)) = AddsSpec c
x

instance Show (AddsSpec c) where show :: AddsSpec c -> String
show = AddsSpec c -> String
forall c. AddsSpec c -> String
showAddsSpec

instance Semigroup (AddsSpec c) where <> :: AddsSpec c -> AddsSpec c -> AddsSpec c
(<>) = AddsSpec c -> AddsSpec c -> AddsSpec c
forall c. AddsSpec c -> AddsSpec c -> AddsSpec c
mergeAddsSpec

instance Monoid (AddsSpec c) where mempty :: AddsSpec c
mempty = AddsSpec c
forall c. AddsSpec c
AddsSpecAny

showAddsSpec :: AddsSpec c -> String
showAddsSpec :: forall c. AddsSpec c -> String
showAddsSpec AddsSpec c
AddsSpecAny = String
"AddsSpecAny"
showAddsSpec (AddsSpecSize String
s Size
size) = [String] -> String
sepsP [String
"AddsSpecSize", String
s, Size -> String
forall a. Show a => a -> String
show Size
size]
showAddsSpec (AddsSpecNever [String]
_) = String
"AddsSpecNever"

mergeAddsSpec :: AddsSpec c -> AddsSpec c -> AddsSpec c
mergeAddsSpec :: forall c. AddsSpec c -> AddsSpec c -> AddsSpec c
mergeAddsSpec (AddsSpecNever [String]
xs) (AddsSpecNever [String]
ys) = [String] -> AddsSpec c
forall c. [String] -> AddsSpec c
AddsSpecNever ([String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ys)
mergeAddsSpec x :: AddsSpec c
x@(AddsSpecNever [String]
_) AddsSpec c
_ = AddsSpec c
x
mergeAddsSpec AddsSpec c
_ x :: AddsSpec c
x@(AddsSpecNever [String]
_) = AddsSpec c
x
mergeAddsSpec AddsSpec c
AddsSpecAny AddsSpec c
x = AddsSpec c
x
mergeAddsSpec AddsSpec c
x AddsSpec c
AddsSpecAny = AddsSpec c
x
mergeAddsSpec a :: AddsSpec c
a@(AddsSpecSize String
nam1 Size
size1) b :: AddsSpec c
b@(AddsSpecSize String
nam2 Size
size2) =
  if String
nam1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
nam2
    then
      [String] -> AddsSpec c
forall c. [String] -> AddsSpec c
AddsSpecNever
        [ String
"vars " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nam1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nam2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" are not the same."
        , AddsSpec c -> String
forall a. Show a => a -> String
show AddsSpec c
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AddsSpec c -> String
forall a. Show a => a -> String
show AddsSpec c
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" are inconsistent."
        ]
    else case Size
size1 Size -> Size -> Size
forall a. Semigroup a => a -> a -> a
<> Size
size2 of
      (SzNever [String]
xs) -> [String] -> AddsSpec c
forall c. [String] -> AddsSpec c
AddsSpecNever ([String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [AddsSpec c -> String
forall a. Show a => a -> String
show AddsSpec c
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AddsSpec c -> String
forall a. Show a => a -> String
show AddsSpec c
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" are inconsistent."])
      Size
size3 -> String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
nam1 Size
size3

-- =======================================
-- Helper function to create AddsSpecSize

-- Translate some thing like [SumsTo _ x <= 4 + 6 + 9] where the variable 'x' is on the left
vLeft :: String -> OrdCond -> Int -> (AddsSpec c)
vLeft :: forall c. String -> OrdCond -> Int -> AddsSpec c
vLeft String
x OrdCond
cond Int
n = String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
x (String -> OrdCond -> Int -> Size
vLeftSize String
x OrdCond
cond Int
n)

vLeftSize :: String -> OrdCond -> Int -> Size
vLeftSize :: String -> OrdCond -> Int -> Size
vLeftSize String
x OrdCond
cond Int
n = (String, OrdCond, Int) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
x, OrdCond
cond, Int
n)

-- Translate some thing like [SumsTo c 8 < 2 + x + 3] where the variable 'x' is on the right
vRight :: Int -> OrdCond -> Int -> String -> AddsSpec c
vRight :: forall c. Int -> OrdCond -> Int -> String -> AddsSpec c
vRight Int
n OrdCond
cond Int
m String
s = String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
s (Int -> OrdCond -> Int -> String -> Size
vRightSize Int
n OrdCond
cond Int
m String
s)

-- vRightSize :: Adds c => c -> OrdCond -> Int ->String - Size
vRightSize :: Int -> OrdCond -> Int -> String -> Size
vRightSize :: Int -> OrdCond -> Int -> String -> Size
vRightSize Int
n OrdCond
cond Int
m String
s = (String, OrdCond, Int) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
s, OrdCond -> OrdCond
reverseOrdCond OrdCond
cond, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)

-- Translate some thing like [SumsTo (Negate x) <= 4 + 6 + 9] where the variable 'x'
-- is on the left, and we want to produce its negation.
vLeftNeg :: String -> OrdCond -> Int -> (AddsSpec c)
vLeftNeg :: forall c. String -> OrdCond -> Int -> AddsSpec c
vLeftNeg String
s OrdCond
cond Int
n = String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
s (Size -> Size
negateSize ((String, OrdCond, Int) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
s, OrdCond
cond, Int
n)))

-- Translate some thing like [SumsTo 8 < 2 + (Negate x) + 3] where the
-- variable 'x' is on the right, and we want to produce its negation.
vRightNeg :: Int -> OrdCond -> Int -> String -> AddsSpec c
vRightNeg :: forall c. Int -> OrdCond -> Int -> String -> AddsSpec c
vRightNeg Int
n OrdCond
cond Int
m String
s = String -> Size -> AddsSpec c
forall c. String -> Size -> AddsSpec c
AddsSpecSize String
s (Size -> Size
negateSize ((String, OrdCond, Int) -> Size
forall a. Adds a => (String, OrdCond, a) -> Size
ordCondToSize (String
s, OrdCond -> OrdCond
reverseOrdCond OrdCond
cond, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)))