diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs new file mode 100644 index 000000000..d756eb57c --- /dev/null +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -0,0 +1,75 @@ +-- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat +-- wide characters as double width. + +module Text.Tabular.AsciiWide where + +import Data.List (intersperse, transpose) +import Text.Tabular +import Hledger.Utils.String + +-- | for simplicity, we assume that each cell is rendered +-- on a single line +render :: (rh -> String) + -> (ch -> String) + -> (a -> String) + -> Table rh ch a + -> String +render fr fc f (Table rh ch cells) = + unlines $ [ bar SingleLine -- +--------------------------------------+ + , renderColumns sizes ch2 + , bar DoubleLine -- +======================================+ + ] ++ + (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++ + [ bar SingleLine ] -- +--------------------------------------+ + where + bar = concat . renderHLine sizes ch2 + -- ch2 and cell2 include the row and column labels + ch2 = Group DoubleLine [Header "", fmap fc ch] + cells2 = headerContents ch2 + : zipWith (\h cs -> h : map f cs) rhStrings cells + -- + renderR (cs,h) = renderColumns sizes $ Group DoubleLine + [ Header h + , fmap fst $ zipHeader "" (map f cs) ch] + rhStrings = map fr $ headerContents rh + -- maximum width for each column + sizes = map (maximum . map strWidth) . transpose $ cells2 + renderRs (Header s) = [s] + renderRs (Group p hs) = concat . intersperse sep . map renderRs $ hs + where sep = renderHLine sizes ch2 p + +-- | We stop rendering on the shortest list! +renderColumns :: [Int] -- ^ max width for each column + -> Header String + -> String +renderColumns is h = "| " ++ coreLine ++ " |" + where + coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h + helper = either hsep (uncurry padLeftWide) + hsep :: Properties -> String + hsep NoLine = " " + hsep SingleLine = " | " + hsep DoubleLine = " || " + +renderHLine :: [Int] -- ^ width specifications + -> Header String + -> Properties + -> [String] +renderHLine _ _ NoLine = [] +renderHLine w h SingleLine = [renderHLine' w '-' h] +renderHLine w h DoubleLine = [renderHLine' w '=' h] + +renderHLine' :: [Int] -> Char -> Header String -> String +renderHLine' is sep h = [ '+', sep ] ++ coreLine ++ [sep, '+'] + where + coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h + helper = either vsep dashes + dashes (i,_) = replicate i sep + vsep NoLine = [sep] + vsep SingleLine = sep : "+" ++ [sep] + vsep DoubleLine = sep : "++" ++ [sep] + +-- padLeft :: Int -> String -> String +-- padLeft l s = padding ++ s +-- where padding = replicate (l - length s) ' ' + diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 175726a2f..1fb9ddf9b 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -250,7 +250,7 @@ import Text.CSV import Test.HUnit import Text.Printf (printf) import Text.Tabular as T -import Text.Tabular.AsciiArt +import Text.Tabular.AsciiWide import Hledger import Hledger.Cli.CliOptions @@ -470,7 +470,7 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table - (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map (Header . padRightWide acctswidth) accts) (T.Group NoLine $ map Header colheadings) (map rowvals items') where @@ -484,7 +484,7 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum' $ map length $ accts + acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) @@ -504,7 +504,7 @@ cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table - (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map (Header . padRightWide acctswidth) accts) (T.Group NoLine $ map Header colheadings) (map rowvals items) where @@ -516,7 +516,7 @@ cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum' $ map length $ accts + acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) @@ -536,7 +536,7 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table - (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map (Header . padRightWide acctswidth) accts) (T.Group NoLine $ map Header colheadings) (map rowvals items) where @@ -548,7 +548,7 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum' $ map length $ accts + acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else [])