diff --git a/cardano-db-tool/app/cardano-db-tool.hs b/cardano-db-tool/app/cardano-db-tool.hs index fa270c470..8ce58d628 100644 --- a/cardano-db-tool/app/cardano-db-tool.hs +++ b/cardano-db-tool/app/cardano-db-tool.hs @@ -289,7 +289,7 @@ pReport = , Opt.command "transactions" $ Opt.info (ReportTransactions <$> pStakeAddress) - (Opt.progDesc "Report the transaction histiory for a given stake address (or addresses)") + (Opt.progDesc "Report the transaction history for a given stake address (or addresses)") ] where pReward :: Parser Report @@ -299,7 +299,7 @@ pReport = [ Opt.command "epoch" $ Opt.info (ReportEpochRewards <$> pEpochNo <*> pStakeAddress) - (Opt.progDesc "Report the rewards fof the gievn epoch and stake address (or addresses)") + (Opt.progDesc "Report the rewards for the given epoch and stake address (or addresses)") , Opt.command "latest" $ Opt.info (ReportLatestRewards <$> pStakeAddress) @@ -307,7 +307,7 @@ pReport = , Opt.command "history" $ Opt.info (ReportAllRewards <$> pStakeAddress) - (Opt.progDesc "Report the reward histiory for a given stake address (or addresses)") + (Opt.progDesc "Report the reward history for a given stake address (or addresses)") ] pStakeAddress :: Parser [Text] diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs b/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs index e6cdfd976..4eeb7068f 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs @@ -71,20 +71,31 @@ queryStakeAddressBalance txOutVariantType address = do renderBalances :: [Balance] -> IO () renderBalances xs = do - putStrLn " stake_address | balance" - putStrLn "-------------------------------------------------------------+----------------" - mapM_ renderReward (List.sortOn (Down . balTotal) xs) - putStrLn "-------------------------------------------------------------+----------------" - putStr " total | " - Text.putStrLn $ leftPad 14 (renderAda . sum $ map balTotal xs) + mapM_ Text.putStrLn (withTotalDivider (renderTable cols (map toRow sorted ++ [totalRow]))) putStrLn "" where - renderReward :: Balance -> IO () - renderReward b = - Text.putStrLn $ - mconcat - [ " " - , balAddress b - , separator - , leftPad 14 (renderAda $ balTotal b) - ] + sorted = List.sortOn (Down . balTotal) xs + + cols :: [(Align, Text)] + cols = + [ (AlignLeft, "stake_address") + , (AlignRight, "balance") + ] + + toRow :: Balance -> [Text] + toRow b = [balAddress b, renderAda (balTotal b)] + + totalRow :: [Text] + totalRow = ["total", renderAda . sum $ map balTotal xs] + + -- Set the total row off with a divider, reusing the header underline. + withTotalDivider :: [Text] -> [Text] + withTotalDivider ls = case ls of + (header : divider : body) -> header : divider : dividerBeforeLast divider body + _ -> ls + + dividerBeforeLast :: Text -> [Text] -> [Text] + dividerBeforeLast divider rows = case rows of + [] -> [] + [final] -> [divider, final] + (row : rest) -> row : dividerBeforeLast divider rest diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/Display.hs b/cardano-db-tool/src/Cardano/DbTool/Report/Display.hs index 6053faf05..19a3ff837 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/Display.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/Display.hs @@ -1,29 +1,57 @@ {-# LANGUAGE OverloadedStrings #-} module Cardano.DbTool.Report.Display ( + Align (..), + formatReportTime, leftPad, + renderTable, rightPad, separator, - spaces, ) where import qualified Data.List as List import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.ICU as ICU +import Data.Time.Clock (UTCTime) +import Data.Time.Format (defaultTimeLocale, formatTime) + +data Align = AlignLeft | AlignRight + +-- Render an aligned table: each column is sized to the widest of its header and +-- its cells, so no column shifts when a value (e.g. a bech32 address) is longer +-- than the header. Returns the header line, the underline, and one line per row. +renderTable :: [(Align, Text)] -> [[Text]] -> [Text] +renderTable cols rows = + headerLine : underline : map renderRow rows + where + aligns = map fst cols + headers = map snd cols + cellWidths + | null rows = map (const 0) cols + | otherwise = map (maximum . map textDisplayLen) (List.transpose rows) + widths = zipWith max (map textDisplayLen headers) cellWidths + + pad :: Align -> Int -> Text -> Text + pad AlignLeft = rightPad + pad AlignRight = leftPad + + headerLine = Text.intercalate separator (zipWith3 pad aligns widths headers) + underline = Text.intercalate "-+-" (map (`Text.replicate` "-") widths) + renderRow = Text.intercalate separator . zipWith3 pad aligns widths + +formatReportTime :: UTCTime -> Text +formatReportTime = Text.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC" leftPad :: Int -> Text -> Text -leftPad width txt = Text.take (width - textDisplayLen txt) spaces <> txt +leftPad width txt = Text.replicate (width - textDisplayLen txt) " " <> txt rightPad :: Int -> Text -> Text -rightPad width txt = txt <> Text.take (width - textDisplayLen txt) spaces +rightPad width txt = txt <> Text.replicate (width - textDisplayLen txt) " " separator :: Text separator = " | " -spaces :: Text -spaces = " " - -- Calculates the screen character count a `Text` object will use when printed. textDisplayLen :: Text -> Int textDisplayLen = List.length . ICU.breaks (ICU.breakCharacter ICU.Root) diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs index 747751e1f..2610448bc 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs @@ -79,32 +79,33 @@ queryHistoryStakeRewards address = do renderRewards :: Text -> [EpochReward] -> IO () renderRewards saddr xs = do Text.putStrLn $ mconcat ["\nRewards for: ", saddr, "\n"] - putStrLn " epoch | reward_date | delegated | pool_id | ticker | reward | RoS (%pa)" - putStrLn "-------+-------------------------+----------------+---------+--------+--------------+-----------" - mapM_ renderReward xs + mapM_ Text.putStrLn (renderTable cols (map toRow xs)) putStrLn "" where - renderReward :: EpochReward -> IO () - renderReward er = - Text.putStrLn $ - mconcat - [ leftPad 6 (textShow $ erEpochNo er) - , separator - , textShow (erDate er) - , separator - , leftPad 14 (DB.renderAda (erDelegated er)) - , separator - , leftPad 7 (textShow $ erPoolId er) - , separator - , rightPad 6 (erPoolTicker er) - , separator - , leftPad 12 (specialRenderAda (erReward er)) - , separator - , Text.pack (if erPercent er == 0.0 then " 0.0" else printf "%8.3f" (erPercent er)) - ] + cols :: [(Align, Text)] + cols = + [ (AlignRight, "epoch") + , (AlignLeft, "reward_date") + , (AlignRight, "delegated") + , (AlignRight, "pool_id") + , (AlignLeft, "ticker") + , (AlignRight, "reward") + , (AlignRight, "RoS (%pa)") + ] + + toRow :: EpochReward -> [Text] + toRow er = + [ textShow (erEpochNo er) + , formatReportTime (erDate er) + , DB.renderAda (erDelegated er) + , textShow (erPoolId er) + , erPoolTicker er + , specialRenderAda (erReward er) + , Text.pack (if erPercent er == 0.0 then "0.0" else printf "%.3f" (erPercent er)) + ] specialRenderAda :: DB.Ada -> Text - specialRenderAda ada = if ada == 0 then "0.0 " else DB.renderAda ada + specialRenderAda ada = if ada == 0 then "0.0" else DB.renderAda ada rewardPercent :: Word64 -> Maybe Word64 -> Double rewardPercent reward mDelegated = diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs index ed4446dc1..a86127e90 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs @@ -83,32 +83,33 @@ queryReward en address (saId, date, DB.DbLovelace delegated, poolId) = do renderRewards :: [EpochReward] -> IO () renderRewards xs = do - putStrLn " epoch | stake_address | delegated | pool_id | ticker | reward | RoS (%pa)" - putStrLn "-------+-------------------------------------------------------------+----------------+-------- +--------+--------------+-----------" - mapM_ renderReward (List.sortOn (Down . erDelegated) xs) + mapM_ Text.putStrLn (renderTable cols (map toRow (List.sortOn (Down . erDelegated) xs))) putStrLn "" where - renderReward :: EpochReward -> IO () - renderReward er = - Text.putStrLn $ - mconcat - [ leftPad 6 (textShow $ erEpochNo er) - , separator - , erAddress er - , separator - , leftPad 14 (DB.renderAda (erDelegated er)) - , separator - , leftPad 7 (textShow $ erPoolId er) - , separator - , rightPad 6 (erPoolTicker er) - , separator - , leftPad 12 (specialRenderAda (erReward er)) - , separator - , Text.pack (if erPercent er == 0.0 then " 0.0" else printf "%8.3f" (erPercent er)) - ] + cols :: [(Align, Text)] + cols = + [ (AlignRight, "epoch") + , (AlignLeft, "stake_address") + , (AlignRight, "delegated") + , (AlignRight, "pool_id") + , (AlignLeft, "ticker") + , (AlignRight, "reward") + , (AlignRight, "RoS (%pa)") + ] + + toRow :: EpochReward -> [Text] + toRow er = + [ textShow (erEpochNo er) + , erAddress er + , DB.renderAda (erDelegated er) + , textShow (erPoolId er) + , erPoolTicker er + , specialRenderAda (erReward er) + , Text.pack (if erPercent er == 0.0 then "0.0" else printf "%.3f" (erPercent er)) + ] specialRenderAda :: DB.Ada -> Text - specialRenderAda ada = if ada == 0 then "0.0 " else DB.renderAda ada + specialRenderAda ada = if ada == 0 then "0.0" else DB.renderAda ada rewardPercent :: Word64 -> Maybe Word64 -> Double rewardPercent reward mDelegated = diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs b/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs index a9bc3bfe5..014faa97b 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs @@ -37,7 +37,7 @@ reportTransactions txOutVariantType addrs = forM_ addrs $ \saddr -> do Text.putStrLn $ "\nTransactions for: " <> saddr <> "\n" xs <- runDbStandaloneSilent (queryStakeAddressTransactions txOutVariantType saddr) - renderTransactions $ coaleseTxs xs + renderTransactions $ coalesceTxs xs -- ------------------------------------------------------------------------------------------------- -- This command is designed to emulate the output of the script: @@ -87,10 +87,10 @@ queryInputs txOutVariantType saId = do pure $ groupByTxHash (map (convertTx Incoming) res1 ++ map (convertTx Outgoing) res2) where groupByTxHash :: [Transaction] -> [Transaction] - groupByTxHash = mapMaybe coaleseInputs . List.groupOn trHash . List.sortOn trHash + groupByTxHash = mapMaybe coalesceInputs . List.groupOn trHash . List.sortOn trHash - coaleseInputs :: [Transaction] -> Maybe Transaction - coaleseInputs xs = + coalesceInputs :: [Transaction] -> Maybe Transaction + coalesceInputs xs = case xs of [] -> Nothing (x : _) -> @@ -111,10 +111,10 @@ queryOutputs txOutVariantType saId = do pure . groupOutputs $ map (convertTx Outgoing) res where groupOutputs :: [Transaction] -> [Transaction] - groupOutputs = mapMaybe coaleseInputs . List.groupOn trHash . List.sortOn trHash + groupOutputs = mapMaybe coalesceInputs . List.groupOn trHash . List.sortOn trHash - coaleseInputs :: [Transaction] -> Maybe Transaction - coaleseInputs xs = + coalesceInputs :: [Transaction] -> Maybe Transaction + coalesceInputs xs = case xs of [] -> Nothing (x : _) -> @@ -136,12 +136,12 @@ sumAmounts = Incoming -> acc + trAmount tr Outgoing -> acc - trAmount tr -coaleseTxs :: [Transaction] -> [Transaction] -coaleseTxs = - mapMaybe coalese . List.groupOn trHash +coalesceTxs :: [Transaction] -> [Transaction] +coalesceTxs = + mapMaybe coalesce . List.groupOn trHash where - coalese :: [Transaction] -> Maybe Transaction - coalese xs = + coalesce :: [Transaction] -> Maybe Transaction + coalesce xs = case xs of [] -> Nothing [a] -> Just a @@ -150,7 +150,7 @@ coaleseTxs = if trAmount a > trAmount b then Transaction (trHash a) (trTime a) Outgoing (trAmount a - trAmount b) else Transaction (trHash a) (trTime a) Incoming (trAmount b - trAmount a) - _otherwise -> error $ "coaleseTxs: " ++ show (length xs) + _otherwise -> error $ "coalesceTxs: " ++ show (length xs) convertTx :: Direction -> (ByteString, UTCTime, DbLovelace) -> Transaction convertTx dir (hash, time, ll) = @@ -163,22 +163,21 @@ convertTx dir (hash, time, ll) = renderTransactions :: [Transaction] -> IO () renderTransactions xs = do - putStrLn " tx_hash | date/time | direction | amount" - putStrLn "------------------------------------------------------------------+-------------------------+-----------+----------------" - mapM_ renderTx xs + mapM_ Text.putStrLn (renderTable cols (map toRow xs)) putStrLn "" where - renderTx :: Transaction -> IO () - renderTx tr = - Text.putStrLn $ - mconcat - [ " " - , trHash tr - , separator - , textShow (trTime tr) - , separator - , " " - , textShow (trDirection tr) - , separator - , leftPad 14 (renderAda $ trAmount tr) - ] + cols :: [(Align, Text)] + cols = + [ (AlignLeft, "tx_hash") + , (AlignLeft, "date/time") + , (AlignLeft, "direction") + , (AlignRight, "amount") + ] + + toRow :: Transaction -> [Text] + toRow tr = + [ trHash tr + , formatReportTime (trTime tr) + , textShow (trDirection tr) + , renderAda (trAmount tr) + ] diff --git a/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs b/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs index 5313d379e..30fe84ba0 100644 --- a/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs +++ b/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs @@ -45,7 +45,7 @@ utxoSetAtSlot txOutVariantType slotNo = do , "\nAfter aggregation:" , " Utxo entries: " ++ show (length aggregated) , " Utxo supply : " ++ show (sum $ map snd aggregated) ++ " Lovelace" - , "\nAfter paritioning:" + , "\nAfter partitioning:" , " Accepted Utxo entries: " ++ show (length accept) , " Rejected Utxo entries: " ++ show (length reject) , " Accepted Utxo supply: " ++ show (sum $ map snd accept) ++ " Lovelace"