{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module suppies tools to tersely describe the differences between 2 values of the same type.
module Test.Cardano.Ledger.TerseTools where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Coin (Coin (..), CompactForm (CompactCoin))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (
  Credential (..),
  Ptr (..),
  StakeReference (..),
 )
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Era (Era)
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.Keys (KeyHash (..))
import Cardano.Ledger.SafeHash (extractHash)
import Cardano.Ledger.Shelley.LedgerState (IncrementalStake (..))
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Ledger.UTxO (UTxO (..))
import Cardano.Slotting.Slot (SlotNo (..))
import qualified Data.Map.Strict as Map

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

class Terse t where
  terse :: t -> String

data Case a b = OnLeft !a !b | OnRight !a !b | SameKey !a !b !b

instance (Terse a, Terse b) => Show (Case a b) where
  show :: Case a b -> String
show (OnLeft a
a b
b) = String
"Left " forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse (a
a, b
b)
  show (OnRight a
a b
b) = String
"Right" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse (a
a, b
b)
  show (SameKey a
a b
b b
c) = String
"Same " forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse (a
a, b
b, b
c)

instance (Terse a, Terse b) => Terse (Case a b) where
  terse :: Case a b -> String
terse Case a b
x = forall a. Show a => a -> String
show Case a b
x

instance (Terse a, Terse b) => Terse (a, b) where
  terse :: (a, b) -> String
terse (a
a, b
b) = String
"(" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse a
a forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse b
b forall a. [a] -> [a] -> [a]
++ String
")"

instance (Terse a, Terse b, Terse c) => Terse (a, b, c) where
  terse :: (a, b, c) -> String
terse (a
a, b
b, c
c) = String
"(" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse a
a forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse b
b forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse c
c forall a. [a] -> [a] -> [a]
++ String
")"

caseKey :: Case p b -> p
caseKey :: forall p b. Case p b -> p
caseKey (OnLeft p
k b
_) = p
k
caseKey (OnRight p
k b
_) = p
k
caseKey (SameKey p
k b
_ b
_) = p
k

-- | we assume the lists are lexigraphically sorted
differences :: (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
differences :: forall a b. (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
differences [] [] = []
differences [(a, b)]
xs [] = (forall a b. (a -> b) -> [a] -> [b]
map (\(a
a, b
b) -> forall a b. a -> b -> Case a b
OnLeft a
a b
b) [(a, b)]
xs)
differences [] [(a, b)]
ys = (forall a b. (a -> b) -> [a] -> [b]
map (\(a
a, b
b) -> forall a b. a -> b -> Case a b
OnRight a
a b
b) [(a, b)]
ys)
differences ((a
a1, b
b1) : [(a, b)]
xs) ((a
a2, b
b2) : [(a, b)]
ys) =
  case forall a. Ord a => a -> a -> Ordering
compare a
a1 a
a2 of
    Ordering
EQ -> if b
b1 forall a. Eq a => a -> a -> Bool
== b
b2 then forall a b. (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
differences [(a, b)]
xs [(a, b)]
ys else (forall a b. a -> b -> b -> Case a b
SameKey a
a1 b
b1 b
b2) forall a. a -> [a] -> [a]
: forall a b. (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
differences [(a, b)]
xs [(a, b)]
ys
    Ordering
LT -> (forall a b. a -> b -> Case a b
OnLeft a
a1 b
b1) forall a. a -> [a] -> [a]
: forall a b. (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
differences [(a, b)]
xs ((a
a2, b
b2) forall a. a -> [a] -> [a]
: [(a, b)]
ys)
    Ordering
GT -> (forall a b. a -> b -> Case a b
OnRight a
a2 b
b2) forall a. a -> [a] -> [a]
: forall a b. (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
differences ((a
a1, b
b1) forall a. a -> [a] -> [a]
: [(a, b)]
xs) [(a, b)]
ys

mapdiffs :: (Ord a, Eq b) => Map.Map a b -> Map.Map a b -> [Case a b]
mapdiffs :: forall a b. (Ord a, Eq b) => Map a b -> Map a b -> [Case a b]
mapdiffs Map a b
mp1 Map a b
mp2 = forall a b. (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
differences (forall k a. Map k a -> [(k, a)]
Map.toAscList Map a b
mp1) (forall k a. Map k a -> [(k, a)]
Map.toAscList Map a b
mp2)

terselist :: Terse a => [Char] -> [a] -> [Char]
terselist :: forall a. Terse a => String -> [a] -> String
terselist String
message [a]
xs = String
"\n" forall a. [a] -> [a] -> [a]
++ String
message forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall t. Terse t => t -> String
terse [a]
xs)

terselistfilter :: Terse a => [Char] -> (a -> Bool) -> [a] -> [Char]
terselistfilter :: forall a. Terse a => String -> (a -> Bool) -> [a] -> String
terselistfilter String
message a -> Bool
p [a]
xs = String
"\n" forall a. [a] -> [a] -> [a]
++ String
message forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall t. Terse t => t -> String
terse (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
xs))

tersemap :: (Terse k, Terse a) => [Char] -> Map.Map k a -> [Char]
tersemap :: forall k a. (Terse k, Terse a) => String -> Map k a -> String
tersemap String
message Map k a
mp = forall a. Terse a => String -> [a] -> String
terselist String
message (forall k a. Map k a -> [(k, a)]
Map.toAscList Map k a
mp)

tersemapfilter :: (Terse k, Terse a) => [Char] -> (a -> Bool) -> Map.Map k a -> [Char]
tersemapfilter :: forall k a.
(Terse k, Terse a) =>
String -> (a -> Bool) -> Map k a -> String
tersemapfilter String
message a -> Bool
p Map k a
mp = forall a. Terse a => String -> (a -> Bool) -> [a] -> String
terselistfilter String
message (\(k
_, a
a) -> a -> Bool
p a
a) (forall k a. Map k a -> [(k, a)]
Map.toAscList Map k a
mp)

tersemapdiffs :: (Terse a, Terse b, Ord a, Eq b) => String -> Map.Map a b -> Map.Map a b -> [Char]
tersemapdiffs :: forall a b.
(Terse a, Terse b, Ord a, Eq b) =>
String -> Map a b -> Map a b -> String
tersemapdiffs String
message Map a b
mp1 Map a b
mp2 = forall a. Terse a => String -> [a] -> String
terselist String
message (forall a b. (Ord a, Eq b) => Map a b -> Map a b -> [Case a b]
mapdiffs Map a b
mp1 Map a b
mp2)

instance Terse (Addr c) where
  terse :: Addr c -> String
terse (Addr Network
_net PaymentCredential c
cred1 (StakeRefBase StakeCredential c
cred2)) = String
"Addr (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse PaymentCredential c
cred1 forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse StakeCredential c
cred2 forall a. [a] -> [a] -> [a]
++ String
")"
  terse (Addr Network
_net PaymentCredential c
cred (StakeRefPtr Ptr
ptr)) = String
"Addr (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse PaymentCredential c
cred forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse Ptr
ptr forall a. [a] -> [a] -> [a]
++ String
")"
  terse (Addr Network
_net PaymentCredential c
cred StakeReference c
StakeRefNull) = String
"Addr (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse PaymentCredential c
cred forall a. [a] -> [a] -> [a]
++ String
") Null"
  terse (AddrBootstrap BootstrapAddress c
x) = String
"BootStrap " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BootstrapAddress c
x

instance Terse (Credential keyrole c) where
  terse :: Credential keyrole c -> String
terse (ScriptHashObj (ScriptHash Hash (ADDRHASH c) EraIndependentScript
hash)) = String
"Script " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Hash (ADDRHASH c) EraIndependentScript
hash
  terse (KeyHashObj (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
hash)) = String
"Key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
hash

instance Terse Ptr where
  terse :: Ptr -> String
terse (Ptr (SlotNo Word64
n) TxIx
i CertIx
j) = String
"Ptr " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word64
n forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TxIx
i forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CertIx
j

instance Terse (TxId era) where
  terse :: TxId era -> String
terse (TxId SafeHash era EraIndependentTxBody
safehash) = forall a. Show a => a -> String
show (forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash era EraIndependentTxBody
safehash)

instance CC.Crypto era => Terse (TxIn era) where
  terse :: TxIn era -> String
terse (TxIn TxId era
txid TxIx
n) = String
"In " forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse TxId era
txid forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TxIx
n

instance Terse (Coin) where
  terse :: Coin -> String
terse (Coin Integer
n) = forall a. Show a => a -> String
show Integer
n

instance Terse (CompactForm Coin) where
  terse :: CompactForm Coin -> String
terse (CompactCoin Word64
n) = forall a. Show a => a -> String
show Word64
n

tersediffincremental :: String -> IncrementalStake c -> IncrementalStake c -> String
tersediffincremental :: forall c.
String -> IncrementalStake c -> IncrementalStake c -> String
tersediffincremental String
message (IStake Map (Credential 'Staking c) (CompactForm Coin)
a Map Ptr (CompactForm Coin)
b) (IStake Map (Credential 'Staking c) (CompactForm Coin)
c Map Ptr (CompactForm Coin)
d) =
  forall a b.
(Terse a, Terse b, Ord a, Eq b) =>
String -> Map a b -> Map a b -> String
tersemapdiffs (String
message forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
"hashes") Map (Credential 'Staking c) (CompactForm Coin)
a Map (Credential 'Staking c) (CompactForm Coin)
c
    forall a. [a] -> [a] -> [a]
++ forall a b.
(Terse a, Terse b, Ord a, Eq b) =>
String -> Map a b -> Map a b -> String
tersemapdiffs (String
message forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
"ptrs") Map Ptr (CompactForm Coin)
b Map Ptr (CompactForm Coin)
d

terseutxo :: (Era era, Terse (Core.TxOut era)) => String -> UTxO era -> String
terseutxo :: forall era.
(Era era, Terse (TxOut era)) =>
String -> UTxO era -> String
terseutxo String
message (UTxO Map (TxIn (EraCrypto era)) (TxOut era)
mp) = forall a. Terse a => String -> [a] -> String
terselist String
message (forall k a. Map k a -> [(k, a)]
Map.toList Map (TxIn (EraCrypto era)) (TxOut era)
mp)