Align report tables, format timestamps, and fix help typos

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,15 +299,15 @@ 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)
                 (Opt.progDesc "Report the latest epoch rewards for a given stake address (or addresses)")
           , 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]

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

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)

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 =

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 =

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)
+      ]

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"