{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

-- | Golden output for the tracing rendering helpers.
--
-- These functions are what the era tracing instances put into the log, and
-- they were reimplemented off @cardano-api@ when the instances moved here.
-- Two of them silently changed shape in the process, which nothing caught --
-- hence these files. They pin the output as bytes so that a change to it has
-- to be an explicit, reviewed change to a golden file.
--
-- A golden file is only ever as good as the review of the diff that created it:
-- these were checked by hand against @cardano-api-11.5.0.0@, the version
-- @cardano-node@ used before the move.
module Test.Consensus.Tracing.Golden (tests) where

import qualified Cardano.Crypto.Hash.Class as Crypto
import Cardano.Ledger.Address (AccountAddress (..), AccountId (..))
import Cardano.Ledger.Alonzo.Scripts (AsItem (..), AsIx (..))
import Cardano.Ledger.BaseTypes
  ( Anchor (..)
  , Mismatch (..)
  , Network (..)
  , Relation (..)
  , StrictMaybe (..)
  , TxIx (..)
  , Url
  , textToUrl
  )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Conway.Governance
  ( GovAction (..)
  , ProposalProcedure (..)
  , Voter (..)
  )
import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
import Cardano.Ledger.Conway.TxCert (ConwayDelegCert (..), ConwayTxCert (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.Scripts (DijkstraPlutusPurpose (..))
import Cardano.Ledger.Hashes
  ( KeyHash (..)
  , KeyRole (..)
  , ScriptHash (..)
  , unsafeMakeSafeHash
  )
import Cardano.Ledger.Mary.Value (PolicyID (..))
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NonEmpty
import Data.Map.NonEmpty (NonEmptyMap)
import qualified Data.Map.NonEmpty as NonEmptyMap
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Ouroboros.Consensus.Tracing.Era.Shelley.Render
import System.FilePath ((</>))
import Test.Tasty
import Test.Tasty.Golden (goldenVsString)
import Test.Util.Paths (getRelPath)

tests :: TestTree
tests :: TestTree
tests =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"Golden"
    [ [Char] -> [Char] -> IO ByteString -> TestTree
goldenVsString
        [Char]
"Era.Shelley.Render"
        ($(getRelPath "golden/tracing") [Char] -> [Char] -> [Char]
</> [Char]
"era-shelley-render.golden")
        (ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([([Char], Text)] -> ByteString
report [([Char], Text)]
shelleyRender))
    ]

--

-- * The rendered values

--

shelleyRender :: [(String, Text)]
shelleyRender :: [([Char], Text)]
shelleyRender =
  [[([Char], Text)]] -> [([Char], Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [
      [ ([Char]
"renderScriptHash", ScriptHash -> Text
renderScriptHash (Char -> ScriptHash
scriptHash Char
'1'))
      ,
        ( [Char]
"renderScriptIntegrityHash Nothing"
        , Value -> Text
json (Maybe ScriptIntegrityHash -> Value
renderScriptIntegrityHash Maybe ScriptIntegrityHash
forall a. Maybe a
Nothing)
        )
      ,
        ( [Char]
"renderScriptIntegrityHash (Just _)"
        , Value -> Text
json (Maybe ScriptIntegrityHash -> Value
renderScriptIntegrityHash (ScriptIntegrityHash -> Maybe ScriptIntegrityHash
forall a. a -> Maybe a
Just (Hash HASH EraIndependentScriptIntegrity -> ScriptIntegrityHash
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Char -> Hash HASH EraIndependentScriptIntegrity
forall h a. HashAlgorithm h => Char -> Hash h a
hash Char
'2'))))
        )
      ,
        ( [Char]
"renderRewardAccount mainnet/key"
        , AccountAddress -> Text
renderRewardAccount (Network -> Credential Staking -> AccountAddress
accountAddress Network
Mainnet (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash Staking
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'3')))
        )
      ,
        ( [Char]
"renderRewardAccount testnet/key"
        , AccountAddress -> Text
renderRewardAccount (Network -> Credential Staking -> AccountAddress
accountAddress Network
Testnet (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash Staking
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'3')))
        )
      ,
        ( [Char]
"renderRewardAccount mainnet/script"
        , AccountAddress -> Text
renderRewardAccount (Network -> Credential Staking -> AccountAddress
accountAddress Network
Mainnet (ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Char -> ScriptHash
scriptHash Char
'4')))
        )
      , ([Char]
"renderTxIn", TxIn -> Text
renderTxIn TxIn
txIn)
      ]
    , -- Every purpose, by index. This is the ExtraRedeemers field, and it has to
      -- keep matching cardano-api's toScriptIndex + ToJSON ScriptWitnessIndex:
      -- a "kind" naming the witness index constructor, and "value".
      [ ([Char]
"renderScriptIndex " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
label, Value -> Text
json (PlutusPurpose AsIx ConwayEra -> Value
forall era. AnyEraScript era => PlutusPurpose AsIx era -> Value
renderScriptIndex PlutusPurpose AsIx ConwayEra
ConwayPlutusPurpose AsIx ConwayEra
purpose))
      | ([Char]
label, ConwayPlutusPurpose AsIx ConwayEra
purpose) <- [([Char], ConwayPlutusPurpose AsIx ConwayEra)]
purposesByIndex
      ]
    , -- Note the asymmetry: spending, rewarding and guarding render their item
      -- directly, the other four wrap it in {"item": ...} via
      -- ToJSON (AsItem ix it). That is what cardano-api did.
      [ ([Char]
"renderScriptPurpose " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
label, Value -> Text
json (PlutusPurpose AsItem ConwayEra -> Value
forall era.
(AnyEraScript era, ToJSON (TxCert era),
 ToJSON (ProposalProcedure era)) =>
PlutusPurpose AsItem era -> Value
renderScriptPurpose PlutusPurpose AsItem ConwayEra
ConwayPlutusPurpose AsItem ConwayEra
purpose))
      | ([Char]
label, ConwayPlutusPurpose AsItem ConwayEra
purpose) <- [([Char], ConwayPlutusPurpose AsItem ConwayEra)]
purposesByItem
      ]
    , -- Guarding only exists from Dijkstra on, so it needs its own era. Going
      -- through DijkstraPlutusPurpose also exercises the other AnyEraScript
      -- instance, rather than only Conway's.

      [ ([Char]
"renderScriptIndex guarding", Value -> Text
json (PlutusPurpose AsIx DijkstraEra -> Value
forall era. AnyEraScript era => PlutusPurpose AsIx era -> Value
renderScriptIndex PlutusPurpose AsIx DijkstraEra
DijkstraPlutusPurpose AsIx DijkstraEra
guardingByIndex))
      , ([Char]
"renderScriptPurpose guarding", Value -> Text
json (PlutusPurpose AsItem DijkstraEra -> Value
forall era.
(AnyEraScript era, ToJSON (TxCert era),
 ToJSON (ProposalProcedure era)) =>
PlutusPurpose AsItem era -> Value
renderScriptPurpose PlutusPurpose AsItem DijkstraEra
DijkstraPlutusPurpose AsItem DijkstraEra
guardingByItem))
      ]
    ,
      [ ([Char]
"renderMissingRedeemers", Value -> Text
json (NonEmpty (PlutusPurpose AsItem ConwayEra, ScriptHash) -> Value
forall era.
(AnyEraScript era, EraPParams era, ToJSON (TxCert era)) =>
NonEmpty (PlutusPurpose AsItem era, ScriptHash) -> Value
renderMissingRedeemers NonEmpty (PlutusPurpose AsItem ConwayEra, ScriptHash)
NonEmpty (ConwayPlutusPurpose AsItem ConwayEra, ScriptHash)
missingRedeemers))
      , ([Char]
"renderIncompleteWithdrawals", Value -> Text
json (NonEmptyMap AccountAddress (Mismatch RelEQ Int) -> Value
forall (rel :: Relation) payload.
(Typeable rel, Show payload) =>
NonEmptyMap AccountAddress (Mismatch rel payload) -> Value
renderIncompleteWithdrawals NonEmptyMap AccountAddress (Mismatch RelEQ Int)
withdrawals))
      ]
    ]

purposesByIndex :: [(String, ConwayPlutusPurpose AsIx ConwayEra)]
purposesByIndex :: [([Char], ConwayPlutusPurpose AsIx ConwayEra)]
purposesByIndex =
  [ ([Char]
"spending", AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx ConwayEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0))
  , ([Char]
"minting", AsIx Word32 PolicyID -> ConwayPlutusPurpose AsIx ConwayEra
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting (Word32 -> AsIx Word32 PolicyID
forall ix it. ix -> AsIx ix it
AsIx Word32
1))
  , ([Char]
"certifying", AsIx Word32 (TxCert ConwayEra)
-> ConwayPlutusPurpose AsIx ConwayEra
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying (Word32 -> AsIx Word32 (ConwayTxCert ConwayEra)
forall ix it. ix -> AsIx ix it
AsIx Word32
2))
  , ([Char]
"withdrawing", AsIx Word32 AccountAddress -> ConwayPlutusPurpose AsIx ConwayEra
forall (f :: * -> * -> *) era.
f Word32 AccountAddress -> ConwayPlutusPurpose f era
ConwayWithdrawing (Word32 -> AsIx Word32 AccountAddress
forall ix it. ix -> AsIx ix it
AsIx Word32
3))
  , ([Char]
"voting", AsIx Word32 Voter -> ConwayPlutusPurpose AsIx ConwayEra
forall (f :: * -> * -> *) era.
f Word32 Voter -> ConwayPlutusPurpose f era
ConwayVoting (Word32 -> AsIx Word32 Voter
forall ix it. ix -> AsIx ix it
AsIx Word32
4))
  , ([Char]
"proposing", AsIx Word32 (ProposalProcedure ConwayEra)
-> ConwayPlutusPurpose AsIx ConwayEra
forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing (Word32 -> AsIx Word32 (ProposalProcedure ConwayEra)
forall ix it. ix -> AsIx ix it
AsIx Word32
5))
  ]

purposesByItem :: [(String, ConwayPlutusPurpose AsItem ConwayEra)]
purposesByItem :: [([Char], ConwayPlutusPurpose AsItem ConwayEra)]
purposesByItem =
  [ ([Char]
"spending", AsItem Word32 TxIn -> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (TxIn -> AsItem Word32 TxIn
forall ix it. it -> AsItem ix it
AsItem TxIn
txIn))
  , ([Char]
"minting", AsItem Word32 PolicyID -> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting (PolicyID -> AsItem Word32 PolicyID
forall ix it. it -> AsItem ix it
AsItem (ScriptHash -> PolicyID
PolicyID (Char -> ScriptHash
scriptHash Char
'5'))))
  , ([Char]
"certifying", AsItem Word32 (TxCert ConwayEra)
-> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying (ConwayTxCert ConwayEra -> AsItem Word32 (ConwayTxCert ConwayEra)
forall ix it. it -> AsItem ix it
AsItem ConwayTxCert ConwayEra
txCert))
  , ([Char]
"withdrawing", AsItem Word32 AccountAddress
-> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 AccountAddress -> ConwayPlutusPurpose f era
ConwayWithdrawing (AccountAddress -> AsItem Word32 AccountAddress
forall ix it. it -> AsItem ix it
AsItem (Network -> Credential Staking -> AccountAddress
accountAddress Network
Mainnet (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash Staking
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'6')))))
  , ([Char]
"voting", AsItem Word32 Voter -> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 Voter -> ConwayPlutusPurpose f era
ConwayVoting (Voter -> AsItem Word32 Voter
forall ix it. it -> AsItem ix it
AsItem (KeyHash StakePool -> Voter
StakePoolVoter (Char -> KeyHash StakePool
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'b'))))
  , ([Char]
"proposing", AsItem Word32 (ProposalProcedure ConwayEra)
-> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing (ProposalProcedure ConwayEra
-> AsItem Word32 (ProposalProcedure ConwayEra)
forall ix it. it -> AsItem ix it
AsItem ProposalProcedure ConwayEra
proposal))
  ]

guardingByIndex :: DijkstraPlutusPurpose AsIx DijkstraEra
guardingByIndex :: DijkstraPlutusPurpose AsIx DijkstraEra
guardingByIndex = AsIx Word32 ScriptHash -> DijkstraPlutusPurpose AsIx DijkstraEra
forall (f :: * -> * -> *) era.
f Word32 ScriptHash -> DijkstraPlutusPurpose f era
DijkstraGuarding (Word32 -> AsIx Word32 ScriptHash
forall ix it. ix -> AsIx ix it
AsIx Word32
6)

guardingByItem :: DijkstraPlutusPurpose AsItem DijkstraEra
guardingByItem :: DijkstraPlutusPurpose AsItem DijkstraEra
guardingByItem = AsItem Word32 ScriptHash
-> DijkstraPlutusPurpose AsItem DijkstraEra
forall (f :: * -> * -> *) era.
f Word32 ScriptHash -> DijkstraPlutusPurpose f era
DijkstraGuarding (ScriptHash -> AsItem Word32 ScriptHash
forall ix it. it -> AsItem ix it
AsItem (Char -> ScriptHash
scriptHash Char
'f'))

txCert :: ConwayTxCert ConwayEra
txCert :: ConwayTxCert ConwayEra
txCert = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (Credential Staking -> StrictMaybe Coin -> ConwayDelegCert
ConwayRegCert (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash Staking
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'c')) StrictMaybe Coin
forall a. StrictMaybe a
SNothing)

proposal :: ProposalProcedure ConwayEra
proposal :: ProposalProcedure ConwayEra
proposal =
  ProposalProcedure
    { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
1000
    , pProcReturnAddr :: AccountAddress
pProcReturnAddr = Network -> Credential Staking -> AccountAddress
accountAddress Network
Mainnet (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash Staking
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'd'))
    , pProcGovAction :: GovAction ConwayEra
pProcGovAction = GovAction ConwayEra
forall era. GovAction era
InfoAction
    , pProcAnchor :: Anchor
pProcAnchor =
        Anchor
          { anchorUrl :: Url
anchorUrl = Text -> Url
url Text
"https://example.com"
          , anchorDataHash :: SafeHash AnchorData
anchorDataHash = Hash HASH AnchorData -> SafeHash AnchorData
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Char -> Hash HASH AnchorData
forall h a. HashAlgorithm h => Char -> Hash h a
hash Char
'e')
          }
    }

missingRedeemers :: NonEmpty.NonEmpty (ConwayPlutusPurpose AsItem ConwayEra, ScriptHash)
missingRedeemers :: NonEmpty (ConwayPlutusPurpose AsItem ConwayEra, ScriptHash)
missingRedeemers =
  (AsItem Word32 TxIn -> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (TxIn -> AsItem Word32 TxIn
forall ix it. it -> AsItem ix it
AsItem TxIn
txIn), Char -> ScriptHash
scriptHash Char
'7')
    (ConwayPlutusPurpose AsItem ConwayEra, ScriptHash)
-> [(ConwayPlutusPurpose AsItem ConwayEra, ScriptHash)]
-> NonEmpty (ConwayPlutusPurpose AsItem ConwayEra, ScriptHash)
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [(AsItem Word32 PolicyID -> ConwayPlutusPurpose AsItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting (PolicyID -> AsItem Word32 PolicyID
forall ix it. it -> AsItem ix it
AsItem (ScriptHash -> PolicyID
PolicyID (Char -> ScriptHash
scriptHash Char
'8'))), Char -> ScriptHash
scriptHash Char
'9')]

withdrawals :: NonEmptyMap AccountAddress (Mismatch RelEQ Int)
withdrawals :: NonEmptyMap AccountAddress (Mismatch RelEQ Int)
withdrawals =
  AccountAddress
-> Mismatch RelEQ Int
-> NonEmptyMap AccountAddress (Mismatch RelEQ Int)
forall k v. k -> v -> NonEmptyMap k v
NonEmptyMap.singleton
    (Network -> Credential Staking -> AccountAddress
accountAddress Network
Mainnet (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash Staking
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'0')))
    Mismatch{mismatchSupplied :: Int
mismatchSupplied = Int
1, mismatchExpected :: Int
mismatchExpected = Int
2}

--

-- * Fixtures

--
-- Deliberately built from a single byte so that the golden file stays readable
-- and a diff points at the rendering rather than at the input.
--

hash :: Crypto.HashAlgorithm h => Char -> Crypto.Hash h a
hash :: forall h a. HashAlgorithm h => Char -> Hash h a
hash Char
c = Hash h ByteString -> Hash h a
forall h a b. Hash h a -> Hash h b
Crypto.castHash ((ByteString -> ByteString) -> ByteString -> Hash h ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id (Char -> ByteString
BS8.singleton Char
c))

scriptHash :: Char -> ScriptHash
scriptHash :: Char -> ScriptHash
scriptHash = Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> (Char -> Hash ADDRHASH EraIndependentScript)
-> Char
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Hash ADDRHASH EraIndependentScript
forall h a. HashAlgorithm h => Char -> Hash h a
hash

keyHash :: Char -> KeyHash r
keyHash :: forall (r :: KeyRole). Char -> KeyHash r
keyHash = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r)
-> (Char -> Hash ADDRHASH (VerKeyDSIGN DSIGN)) -> Char -> KeyHash r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall h a. HashAlgorithm h => Char -> Hash h a
hash

accountAddress :: Network -> Credential Staking -> AccountAddress
accountAddress :: Network -> Credential Staking -> AccountAddress
accountAddress Network
n Credential Staking
c = Network -> AccountId -> AccountAddress
AccountAddress Network
n (Credential Staking -> AccountId
AccountId Credential Staking
c)

txIn :: TxIn
txIn :: TxIn
txIn = TxId -> TxIx -> TxIn
TxIn (SafeHash EraIndependentTxBody -> TxId
TxId (Hash HASH EraIndependentTxBody -> SafeHash EraIndependentTxBody
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Char -> Hash HASH EraIndependentTxBody
forall h a. HashAlgorithm h => Char -> Hash h a
hash Char
'a'))) (Word16 -> TxIx
TxIx Word16
0)

-- | 'textToUrl' only rejects text longer than the given bound, which the
-- literals here are not.
url :: Text -> Url
url :: Text -> Url
url Text
t = Url -> Maybe Url -> Url
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Url
forall a. HasCallStack => [Char] -> a
error ([Char]
"golden: not a URL: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
t)) (Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
t)

--

-- * Report rendering

--

json :: Aeson.Value -> Text
json :: Value -> Text
json = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode

report :: [(String, Text)] -> BL.ByteString
report :: [([Char], Text)] -> ByteString
report [([Char], Text)]
items =
  ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> ([Text] -> ByteString) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$
    [[Char] -> Text
Text.pack ([Char] -> [Char]
pad [Char]
label) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value | ([Char]
label, Text
value) <- [([Char], Text)]
items]
 where
  width :: Int
width = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (([Char], Text) -> Int) -> [([Char], Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int)
-> (([Char], Text) -> [Char]) -> ([Char], Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Text) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], Text)]
items)
  pad :: [Char] -> [Char]
pad [Char]
l = [Char]
l [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
l) Char
' '