{-# 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 Cardano.Ledger.Core
import Cardano.Ledger.Credential (
  Credential (..),
  Ptr (..),
  StakeReference (..),
 )
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 = forall a. Show a => a -> String
show

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 where
  terse :: Addr -> String
terse (Addr Network
_net PaymentCredential
cred1 (StakeRefBase Credential 'Staking
cred2)) = String
"Addr (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse PaymentCredential
cred1 forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse Credential 'Staking
cred2 forall a. [a] -> [a] -> [a]
++ String
")"
  terse (Addr Network
_net PaymentCredential
cred (StakeRefPtr Ptr
ptr)) = String
"Addr (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse PaymentCredential
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
cred StakeReference
StakeRefNull) = String
"Addr (" forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse PaymentCredential
cred forall a. [a] -> [a] -> [a]
++ String
") Null"
  terse (AddrBootstrap BootstrapAddress
x) = String
"BootStrap " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BootstrapAddress
x

instance Terse (Credential r) where
  terse :: Credential r -> String
terse (ScriptHashObj (ScriptHash Hash ADDRHASH EraIndependentScript
hash)) = String
"Script " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Hash ADDRHASH EraIndependentScript
hash
  terse (KeyHashObj (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
hash)) = String
"Key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Hash ADDRHASH (VerKeyDSIGN DSIGN)
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 where
  terse :: TxId -> String
terse (TxId SafeHash EraIndependentTxBody
safehash) = forall a. Show a => a -> String
show (forall i. SafeHash i -> Hash HASH i
extractHash SafeHash EraIndependentTxBody
safehash)

instance Terse TxIn where
  terse :: TxIn -> String
terse (TxIn TxId
txid TxIx
n) = String
"In " forall a. [a] -> [a] -> [a]
++ forall t. Terse t => t -> String
terse TxId
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 -> IncrementalStake -> String
tersediffincremental :: String -> IncrementalStake -> IncrementalStake -> String
tersediffincremental String
message (IStake Map (Credential 'Staking) (CompactForm Coin)
a Map Ptr (CompactForm Coin)
b) (IStake Map (Credential 'Staking) (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) (CompactForm Coin)
a Map (Credential 'Staking) (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 :: Terse (TxOut era) => String -> UTxO era -> String
terseutxo :: forall era. Terse (TxOut era) => String -> UTxO era -> String
terseutxo String
message (UTxO Map TxIn (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 (TxOut era)
mp)