mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-10 05:39:31 +03:00
lib,cli: Use Text Builder for Balance commands.
This commit is contained in:
Stephen Morgan
parent
089564b04b
commit
462a13cad7
@ -2,7 +2,10 @@
|
||||
-- hledger's report item fields. The formats are used by
|
||||
-- report-specific renderers like renderBalanceReportItem.
|
||||
|
||||
{-# LANGUAGE FlexibleContexts, OverloadedStrings, TypeFamilies, PackageImports #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Hledger.Data.StringFormat (
|
||||
parseStringFormat
|
||||
@ -21,12 +24,13 @@ import Numeric (readDec)
|
||||
import Data.Char (isPrint)
|
||||
import Data.Default (Default(..))
|
||||
import Data.Maybe (isJust)
|
||||
-- import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char (char, digitChar, string)
|
||||
|
||||
import Hledger.Utils.Parse (SimpleStringParser)
|
||||
import Hledger.Utils.String (formatString)
|
||||
import Hledger.Utils.Parse (SimpleTextParser)
|
||||
import Hledger.Utils.Text (formatText)
|
||||
import Hledger.Utils.Test
|
||||
|
||||
-- | A format specification/template to use when rendering a report line item as text.
|
||||
@ -53,7 +57,7 @@ data StringFormat =
|
||||
deriving (Show, Eq)
|
||||
|
||||
data StringFormatComponent =
|
||||
FormatLiteral String -- ^ Literal text to be rendered as-is
|
||||
FormatLiteral Text -- ^ Literal text to be rendered as-is
|
||||
| FormatField Bool
|
||||
(Maybe Int)
|
||||
(Maybe Int)
|
||||
@ -102,14 +106,14 @@ defaultBalanceLineFormat = BottomAligned (Just 20) [
|
||||
----------------------------------------------------------------------
|
||||
|
||||
-- | Parse a string format specification, or return a parse error.
|
||||
parseStringFormat :: String -> Either String StringFormat
|
||||
parseStringFormat :: Text -> Either String StringFormat
|
||||
parseStringFormat input = case (runParser (stringformatp <* eof) "(unknown)") input of
|
||||
Left y -> Left $ show y
|
||||
Right x -> Right x
|
||||
|
||||
defaultStringFormatStyle = BottomAligned
|
||||
|
||||
stringformatp :: SimpleStringParser StringFormat
|
||||
stringformatp :: SimpleTextParser StringFormat
|
||||
stringformatp = do
|
||||
alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String))
|
||||
let constructor =
|
||||
@ -120,19 +124,19 @@ stringformatp = do
|
||||
_ -> defaultStringFormatStyle Nothing
|
||||
constructor <$> many componentp
|
||||
|
||||
componentp :: SimpleStringParser StringFormatComponent
|
||||
componentp :: SimpleTextParser StringFormatComponent
|
||||
componentp = formatliteralp <|> formatfieldp
|
||||
|
||||
formatliteralp :: SimpleStringParser StringFormatComponent
|
||||
formatliteralp :: SimpleTextParser StringFormatComponent
|
||||
formatliteralp = do
|
||||
s <- some c
|
||||
s <- T.pack <$> some c
|
||||
return $ FormatLiteral s
|
||||
where
|
||||
isPrintableButNotPercentage x = isPrint x && x /= '%'
|
||||
c = (satisfy isPrintableButNotPercentage <?> "printable character")
|
||||
<|> try (string "%%" >> return '%')
|
||||
|
||||
formatfieldp :: SimpleStringParser StringFormatComponent
|
||||
formatfieldp :: SimpleTextParser StringFormatComponent
|
||||
formatfieldp = do
|
||||
char '%'
|
||||
leftJustified <- optional (char '-')
|
||||
@ -147,7 +151,7 @@ formatfieldp = do
|
||||
Just text -> Just m where ((m,_):_) = readDec text
|
||||
_ -> Nothing
|
||||
|
||||
fieldp :: SimpleStringParser ReportItemField
|
||||
fieldp :: SimpleTextParser ReportItemField
|
||||
fieldp = do
|
||||
try (string "account" >> return AccountField)
|
||||
<|> try (string "depth_spacer" >> return DepthSpacerField)
|
||||
@ -161,8 +165,8 @@ fieldp = do
|
||||
formatStringTester fs value expected = actual @?= expected
|
||||
where
|
||||
actual = case fs of
|
||||
FormatLiteral l -> formatString False Nothing Nothing l
|
||||
FormatField leftJustify min max _ -> formatString leftJustify min max value
|
||||
FormatLiteral l -> formatText False Nothing Nothing l
|
||||
FormatField leftJustify min max _ -> formatText leftJustify min max value
|
||||
|
||||
tests_StringFormat = tests "StringFormat" [
|
||||
|
||||
@ -176,7 +180,7 @@ tests_StringFormat = tests "StringFormat" [
|
||||
formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description "
|
||||
formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des"
|
||||
|
||||
,let s `gives` expected = test s $ parseStringFormat s @?= Right expected
|
||||
,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected
|
||||
in tests "parseStringFormat" [
|
||||
"" `gives` (defaultStringFormatStyle Nothing [])
|
||||
, "D" `gives` (defaultStringFormatStyle Nothing [FormatLiteral "D"])
|
||||
|
||||
@ -27,6 +27,7 @@ module Hledger.Reports.BudgetReport (
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Arrow (first)
|
||||
import Data.Decimal
|
||||
import Data.Default (def)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
@ -42,12 +43,12 @@ import Safe
|
||||
--import Data.Maybe
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map (Map)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
--import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
--import System.Console.CmdArgs.Explicit as C
|
||||
--import Lucid as L
|
||||
|
||||
import Text.Printf (printf)
|
||||
import Text.Tabular as T
|
||||
import Text.Tabular.AsciiWide as T
|
||||
|
||||
@ -68,7 +69,7 @@ type BudgetCell = (Maybe Change, Maybe BudgetGoal)
|
||||
type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
|
||||
type BudgetReport = PeriodicReport DisplayName BudgetCell
|
||||
|
||||
type BudgetDisplayCell = ((String, Int), Maybe ((String, Int), Maybe (String, Int)))
|
||||
type BudgetDisplayCell = ((Text, Int), Maybe ((Text, Int), Maybe (Text, Int)))
|
||||
|
||||
-- | Calculate per-account, per-period budget (balance change) goals
|
||||
-- from all periodic transactions, calculate actual balance changes
|
||||
@ -219,23 +220,23 @@ combineBudgetAndActual ropts j
|
||||
totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change
|
||||
|
||||
-- | Render a budget report as plain text suitable for console output.
|
||||
budgetReportAsText :: ReportOpts -> BudgetReport -> String
|
||||
budgetReportAsText ropts@ReportOpts{..} budgetr =
|
||||
title ++ "\n\n" ++
|
||||
renderTable def{tableBorders=False,prettyTable=pretty_tables_}
|
||||
budgetReportAsText :: ReportOpts -> BudgetReport -> TL.Text
|
||||
budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
|
||||
TB.fromText title <> TB.fromText "\n\n" <>
|
||||
renderTableB def{tableBorders=False,prettyTable=pretty_tables_}
|
||||
(alignCell TopLeft) (alignCell TopRight) (uncurry showcell) displayTableWithWidths
|
||||
where
|
||||
title = printf "Budget performance in %s%s:"
|
||||
(showDateSpan $ periodicReportSpan budgetr)
|
||||
(case value_ of
|
||||
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
|
||||
<> (case value_ of
|
||||
Just (AtCost _mc) -> ", valued at cost"
|
||||
Just (AtThen _mc) -> error' unsupportedValueThenError -- PARTIAL:
|
||||
Just (AtEnd _mc) -> ", valued at period ends"
|
||||
Just (AtNow _mc) -> ", current value"
|
||||
Just (AtDate d _mc) -> ", valued at " ++ T.unpack (showDate d)
|
||||
Just (AtDate d _mc) -> ", valued at " <> showDate d
|
||||
Nothing -> "")
|
||||
<> ":"
|
||||
|
||||
displayTableWithWidths :: Table String String ((Int, Int, Int), BudgetDisplayCell)
|
||||
displayTableWithWidths :: Table Text Text ((Int, Int, Int), BudgetDisplayCell)
|
||||
displayTableWithWidths = Table rh ch $ map (zipWith (,) widths) displaycells
|
||||
Table rh ch displaycells = case budgetReportAsTable ropts budgetr of
|
||||
Table rh' ch' vals -> maybetranspose . Table rh' ch' $ map (map displayCell) vals
|
||||
@ -244,8 +245,8 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
|
||||
where
|
||||
actual' = fromMaybe 0 actual
|
||||
budgetAndPerc b = (showamt b, showper <$> percentage actual' b)
|
||||
showamt = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) color_
|
||||
showper p = let str = show (roundTo 0 p) in (str, length str)
|
||||
showamt = first T.pack . showMixedOneLine showAmountWithoutPrice Nothing (Just 32) color_
|
||||
showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str)
|
||||
cellWidth ((_,wa), Nothing) = (wa, 0, 0)
|
||||
cellWidth ((_,wa), Just ((_,wb), Nothing)) = (wa, wb, 0)
|
||||
cellWidth ((_,wa), Just ((_,wb), Just (_,wp))) = (wa, wb, wp)
|
||||
@ -259,14 +260,14 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
|
||||
-- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
|
||||
showcell :: (Int, Int, Int) -> BudgetDisplayCell -> Cell
|
||||
showcell (actualwidth, budgetwidth, percentwidth) ((actual,wa), mbudget) =
|
||||
Cell TopRight [(replicate (actualwidth - wa) ' ' ++ actual ++ budgetstr, actualwidth + totalbudgetwidth)]
|
||||
Cell TopRight [(T.replicate (actualwidth - wa) " " <> actual <> budgetstr, actualwidth + totalbudgetwidth)]
|
||||
where
|
||||
totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
|
||||
totalbudgetwidth = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3
|
||||
budgetstr = case mbudget of
|
||||
Nothing -> replicate totalbudgetwidth ' '
|
||||
Just ((budget, wb), Nothing) -> " [" ++ replicate totalpercentwidth ' ' ++ replicate (budgetwidth - wb) ' ' ++ budget ++ "]"
|
||||
Just ((budget, wb), Just (pct, wp)) -> " [" ++ replicate (percentwidth - wp) ' ' ++ pct ++ "% of " ++ replicate (budgetwidth - wb) ' ' ++ budget ++ "]"
|
||||
Nothing -> T.replicate totalbudgetwidth " "
|
||||
Just ((budget, wb), Nothing) -> " [" <> T.replicate totalpercentwidth " " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"
|
||||
Just ((budget, wb), Just (pct, wp)) -> " [" <> T.replicate (percentwidth - wp) " " <> pct <> "% of " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"
|
||||
|
||||
-- | Calculate the percentage of actual change to budget goal to show, if any.
|
||||
-- If valuing at cost, both amounts are converted to cost before comparing.
|
||||
@ -289,7 +290,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
|
||||
| otherwise = id
|
||||
|
||||
-- | Build a 'Table' from a multi-column balance report.
|
||||
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
|
||||
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text (Maybe MixedAmount, Maybe MixedAmount)
|
||||
budgetReportAsTable
|
||||
ropts@ReportOpts{balancetype_}
|
||||
(PeriodicReport spans rows (PeriodicReportRow _ coltots grandtot grandavg)) =
|
||||
@ -299,7 +300,7 @@ budgetReportAsTable
|
||||
(T.Group NoLine $ map Header colheadings)
|
||||
(map rowvals rows)
|
||||
where
|
||||
colheadings = map (T.unpack . reportPeriodName balancetype_ spans) spans
|
||||
colheadings = map (reportPeriodName balancetype_ spans) spans
|
||||
++ [" Total" | row_total_ ropts]
|
||||
++ ["Average" | average_ ropts]
|
||||
|
||||
@ -308,8 +309,8 @@ budgetReportAsTable
|
||||
-- budgetReport sets accountlistmode to ALTree. Find a principled way to do
|
||||
-- this.
|
||||
renderacct row = case accountlistmode_ ropts of
|
||||
ALTree -> replicate ((prrDepth row - 1)*2) ' ' ++ T.unpack (prrDisplayName row)
|
||||
ALFlat -> T.unpack . accountNameDrop (drop_ ropts) $ prrFullName row
|
||||
ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row
|
||||
ALFlat -> accountNameDrop (drop_ ropts) $ prrFullName row
|
||||
rowvals (PeriodicReportRow _ as rowtot rowavg) =
|
||||
as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts]
|
||||
addtotalrow
|
||||
|
||||
@ -167,7 +167,7 @@ rawOptsToReportOpts rawopts = do
|
||||
supports_color <- hSupportsANSIColor stdout
|
||||
|
||||
let colorflag = stringopt "color" rawopts
|
||||
formatstring = maybestringopt "format" rawopts
|
||||
formatstring = T.pack <$> maybestringopt "format" rawopts
|
||||
querystring = map T.pack $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
|
||||
|
||||
format <- case parseStringFormat <$> formatstring of
|
||||
|
||||
@ -55,6 +55,8 @@ module Hledger.Utils.String (
|
||||
import Data.Char (isSpace, toLower, toUpper)
|
||||
import Data.Default (def)
|
||||
import Data.List (intercalate)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Text.Megaparsec ((<|>), between, many, noneOf, sepBy)
|
||||
import Text.Megaparsec.Char (char)
|
||||
import Text.Printf (printf)
|
||||
@ -63,7 +65,7 @@ import Hledger.Utils.Parse
|
||||
import Hledger.Utils.Regex (toRegex', regexReplace)
|
||||
import Text.Tabular (Header(..), Properties(..))
|
||||
import Text.Tabular.AsciiWide (Align(..), Cell(..), TableOpts(..), renderRow)
|
||||
import Text.WideString (strWidth, charWidth)
|
||||
import Text.WideString (charWidth, strWidth, textWidth)
|
||||
|
||||
|
||||
-- | Take elements from the end of a list.
|
||||
@ -184,16 +186,16 @@ unbracket s
|
||||
-- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded.
|
||||
-- Treats wide characters as double width.
|
||||
concatTopPadded :: [String] -> String
|
||||
concatTopPadded = renderRow def{tableBorders=False, borderSpaces=False}
|
||||
concatTopPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}
|
||||
. Group NoLine . map (Header . cell)
|
||||
where cell = Cell BottomLeft . map (\x -> (x, strWidth x)) . lines
|
||||
where cell = Cell BottomLeft . map (\x -> (x, textWidth x)) . T.lines . T.pack
|
||||
|
||||
-- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.
|
||||
-- Treats wide characters as double width.
|
||||
concatBottomPadded :: [String] -> String
|
||||
concatBottomPadded = renderRow def{tableBorders=False, borderSpaces=False}
|
||||
concatBottomPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}
|
||||
. Group NoLine . map (Header . cell)
|
||||
where cell = Cell TopLeft . map (\x -> (x, strWidth x)) . lines
|
||||
where cell = Cell TopLeft . map (\x -> (x, textWidth x)) . T.lines . T.pack
|
||||
|
||||
|
||||
-- | Join multi-line strings horizontally, after compressing each of
|
||||
|
||||
@ -31,7 +31,7 @@ module Hledger.Utils.Text
|
||||
-- -- * single-line layout
|
||||
-- elideLeft,
|
||||
textElideRight,
|
||||
-- formatString,
|
||||
formatText,
|
||||
-- -- * multi-line layout
|
||||
textConcatTopPadded,
|
||||
-- concatBottomPadded,
|
||||
@ -97,15 +97,15 @@ wrap start end x = start <> x <> end
|
||||
textChomp :: Text -> Text
|
||||
textChomp = T.dropWhileEnd (`elem` ['\r', '\n'])
|
||||
|
||||
-- -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
|
||||
-- -- Works on multi-line strings too (but will rewrite non-unix line endings).
|
||||
-- formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String
|
||||
-- formatString leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s
|
||||
-- where
|
||||
-- justify = if leftJustified then "-" else ""
|
||||
-- minwidth' = maybe "" show minwidth
|
||||
-- maxwidth' = maybe "" (("."++).show) maxwidth
|
||||
-- fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s"
|
||||
-- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
|
||||
-- Works on multi-line strings too (but will rewrite non-unix line endings).
|
||||
formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text
|
||||
formatText leftJustified minwidth maxwidth =
|
||||
T.intercalate "\n" . map (pad . clip) . T.lines
|
||||
where
|
||||
pad = maybe id justify minwidth
|
||||
clip = maybe id T.take maxwidth
|
||||
justify n = if leftJustified then T.justifyLeft n ' ' else T.justifyRight n ' '
|
||||
|
||||
-- underline :: String -> String
|
||||
-- underline s = s' ++ replicate (length s) '-' ++ "\n"
|
||||
|
||||
@ -1,14 +1,21 @@
|
||||
-- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat
|
||||
-- wide characters as double width.
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Text.Tabular.AsciiWide where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Default (Default(..))
|
||||
import Data.List (intersperse, transpose)
|
||||
import Data.Semigroup (stimesMonoid)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText)
|
||||
import Safe (maximumMay)
|
||||
import Text.Tabular
|
||||
import Text.WideString (strWidth)
|
||||
import Text.WideString (textWidth)
|
||||
|
||||
|
||||
-- | The options to use for rendering a table.
|
||||
@ -25,7 +32,7 @@ instance Default TableOpts where
|
||||
}
|
||||
|
||||
-- | Cell contents along an alignment
|
||||
data Cell = Cell Align [(String, Int)]
|
||||
data Cell = Cell Align [(Text, Int)]
|
||||
deriving (Show)
|
||||
|
||||
-- | How to align text in a cell
|
||||
@ -36,8 +43,8 @@ emptyCell :: Cell
|
||||
emptyCell = Cell TopRight []
|
||||
|
||||
-- | Create a single-line cell from the given contents with its natural width.
|
||||
alignCell :: Align -> String -> Cell
|
||||
alignCell a x = Cell a [(x, strWidth x)]
|
||||
alignCell :: Align -> Text -> Cell
|
||||
alignCell a x = Cell a [(x, textWidth x)]
|
||||
|
||||
-- | Return the width of a Cell.
|
||||
cellWidth :: Cell -> Int
|
||||
@ -45,19 +52,28 @@ cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map snd xs
|
||||
|
||||
|
||||
-- | Render a table according to common options, for backwards compatibility
|
||||
render :: Bool -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String
|
||||
render :: Bool -> (rh -> Text) -> (ch -> Text) -> (a -> Text) -> Table rh ch a -> TL.Text
|
||||
render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell . fc) (cell . f)
|
||||
where cell = alignCell TopRight
|
||||
|
||||
-- | Render a table according to various cell specifications
|
||||
-- | Render a table according to various cell specifications>
|
||||
renderTable :: TableOpts -- ^ Options controlling Table rendering
|
||||
-> (rh -> Cell) -- ^ Rendering function for row headers
|
||||
-> (ch -> Cell) -- ^ Rendering function for column headers
|
||||
-> (a -> Cell) -- ^ Function determining the string and width of a cell
|
||||
-> Table rh ch a
|
||||
-> String
|
||||
renderTable topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) =
|
||||
unlines . addBorders $
|
||||
-> TL.Text
|
||||
renderTable topts fr fc f = toLazyText . renderTableB topts fr fc f
|
||||
|
||||
-- | A version of renderTable which returns the underlying Builder.
|
||||
renderTableB :: TableOpts -- ^ Options controlling Table rendering
|
||||
-> (rh -> Cell) -- ^ Rendering function for row headers
|
||||
-> (ch -> Cell) -- ^ Rendering function for column headers
|
||||
-> (a -> Cell) -- ^ Function determining the string and width of a cell
|
||||
-> Table rh ch a
|
||||
-> Builder
|
||||
renderTableB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) =
|
||||
unlinesB . addBorders $
|
||||
renderColumns topts sizes ch2
|
||||
: bar VM DoubleLine -- +======================================+
|
||||
: renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)
|
||||
@ -83,49 +99,54 @@ renderTable topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (T
|
||||
|
||||
-- borders and bars
|
||||
addBorders xs = if borders then bar VT SingleLine : xs ++ [bar VB SingleLine] else xs
|
||||
bar vpos prop = concat $ renderHLine vpos borders pretty sizes ch2 prop
|
||||
bar vpos prop = mconcat $ renderHLine vpos borders pretty sizes ch2 prop
|
||||
unlinesB = (<>singleton '\n') . mconcat . intersperse "\n"
|
||||
|
||||
-- | Render a single row according to cell specifications.
|
||||
renderRow :: TableOpts -> Header Cell -> String
|
||||
renderRow topts h = renderColumns topts is h
|
||||
renderRow :: TableOpts -> Header Cell -> TL.Text
|
||||
renderRow topts = toLazyText . renderRowB topts
|
||||
|
||||
-- | A version of renderRow which returns the underlying Builder.
|
||||
renderRowB:: TableOpts -> Header Cell -> Builder
|
||||
renderRowB topts h = renderColumns topts is h
|
||||
where is = map (\(Cell _ xs) -> fromMaybe 0 . maximumMay $ map snd xs) $ headerContents h
|
||||
|
||||
|
||||
verticalBar :: Bool -> Char
|
||||
verticalBar pretty = if pretty then '│' else '|'
|
||||
|
||||
leftBar :: Bool -> Bool -> String
|
||||
leftBar pretty True = verticalBar pretty : " "
|
||||
leftBar pretty False = [verticalBar pretty]
|
||||
leftBar :: Bool -> Bool -> Builder
|
||||
leftBar pretty True = fromString $ verticalBar pretty : " "
|
||||
leftBar pretty False = singleton $ verticalBar pretty
|
||||
|
||||
rightBar :: Bool -> Bool -> String
|
||||
rightBar pretty True = ' ' : [verticalBar pretty]
|
||||
rightBar pretty False = [verticalBar pretty]
|
||||
rightBar :: Bool -> Bool -> Builder
|
||||
rightBar pretty True = fromString $ ' ' : [verticalBar pretty]
|
||||
rightBar pretty False = singleton $ verticalBar pretty
|
||||
|
||||
midBar :: Bool -> Bool -> String
|
||||
midBar pretty True = ' ' : verticalBar pretty : " "
|
||||
midBar pretty False = [verticalBar pretty]
|
||||
midBar :: Bool -> Bool -> Builder
|
||||
midBar pretty True = fromString $ ' ' : verticalBar pretty : " "
|
||||
midBar pretty False = singleton $ verticalBar pretty
|
||||
|
||||
doubleMidBar :: Bool -> Bool -> String
|
||||
doubleMidBar pretty True = if pretty then " ║ " else " || "
|
||||
doubleMidBar pretty False = if pretty then "║" else "||"
|
||||
doubleMidBar :: Bool -> Bool -> Builder
|
||||
doubleMidBar pretty True = fromText $ if pretty then " ║ " else " || "
|
||||
doubleMidBar pretty False = fromText $ if pretty then "║" else "||"
|
||||
|
||||
-- | We stop rendering on the shortest list!
|
||||
renderColumns :: TableOpts -- ^ rendering options for the table
|
||||
-> [Int] -- ^ max width for each column
|
||||
-> Header Cell
|
||||
-> String
|
||||
-> Builder
|
||||
renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=spaces} is h =
|
||||
concat . intersperse "\n" -- Put each line on its own line
|
||||
. map (addBorders . concat) . transpose -- Change to a list of lines and add borders
|
||||
mconcat . intersperse "\n" -- Put each line on its own line
|
||||
. map (addBorders . mconcat) . transpose -- Change to a list of lines and add borders
|
||||
. map (either hsep padCell) . flattenHeader -- We now have a matrix of strings
|
||||
. zipHeader 0 is $ padRow <$> h -- Pad cell height and add width marker
|
||||
where
|
||||
-- Pad each cell to have the appropriate width
|
||||
padCell (w, Cell TopLeft ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls
|
||||
padCell (w, Cell BottomLeft ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls
|
||||
padCell (w, Cell TopRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls
|
||||
padCell (w, Cell BottomRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls
|
||||
padCell (w, Cell TopLeft ls) = map (\(x,xw) -> fromText x <> fromText (T.replicate (w - xw) " ")) ls
|
||||
padCell (w, Cell BottomLeft ls) = map (\(x,xw) -> fromText x <> fromText (T.replicate (w - xw) " ")) ls
|
||||
padCell (w, Cell TopRight ls) = map (\(x,xw) -> fromText (T.replicate (w - xw) " ") <> fromText x) ls
|
||||
padCell (w, Cell BottomRight ls) = map (\(x,xw) -> fromText (T.replicate (w - xw) " ") <> fromText x) ls
|
||||
|
||||
-- Pad each cell to have the same number of lines
|
||||
padRow (Cell TopLeft ls) = Cell TopLeft $ ls ++ replicate (nLines - length ls) ("",0)
|
||||
@ -133,13 +154,13 @@ renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=s
|
||||
padRow (Cell BottomLeft ls) = Cell BottomLeft $ replicate (nLines - length ls) ("",0) ++ ls
|
||||
padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) ("",0) ++ ls
|
||||
|
||||
hsep :: Properties -> [String]
|
||||
hsep :: Properties -> [Builder]
|
||||
hsep NoLine = replicate nLines $ if spaces then " " else ""
|
||||
hsep SingleLine = replicate nLines $ midBar pretty spaces
|
||||
hsep DoubleLine = replicate nLines $ doubleMidBar pretty spaces
|
||||
|
||||
addBorders xs | borders = leftBar pretty spaces ++ xs ++ rightBar pretty spaces
|
||||
| spaces = ' ' : xs ++ " "
|
||||
addBorders xs | borders = leftBar pretty spaces <> xs <> rightBar pretty spaces
|
||||
| spaces = fromText " " <> xs <> fromText " "
|
||||
| otherwise = xs
|
||||
|
||||
nLines = fromMaybe 0 . maximumMay . map (\(Cell _ ls) -> length ls) $ headerContents h
|
||||
@ -150,52 +171,48 @@ renderHLine :: VPos
|
||||
-> [Int] -- ^ width specifications
|
||||
-> Header a
|
||||
-> Properties
|
||||
-> [String]
|
||||
-> [Builder]
|
||||
renderHLine _ _ _ _ _ NoLine = []
|
||||
renderHLine vpos borders pretty w h prop = [renderHLine' vpos borders pretty prop w h]
|
||||
|
||||
renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String
|
||||
renderHLine' vpos borders pretty prop is h = addBorders $ sep ++ coreLine ++ sep
|
||||
renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder
|
||||
renderHLine' vpos borders pretty prop is h = addBorders $ sep <> coreLine <> sep
|
||||
where
|
||||
addBorders xs = if borders then edge HL ++ xs ++ edge HR else xs
|
||||
addBorders xs = if borders then edge HL <> xs <> edge HR else xs
|
||||
edge hpos = boxchar vpos hpos SingleLine prop pretty
|
||||
coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h
|
||||
coreLine = foldMap helper $ flattenHeader $ zipHeader 0 is h
|
||||
helper = either vsep dashes
|
||||
dashes (i,_) = concat (replicate i sep)
|
||||
dashes (i,_) = stimesMonoid i sep
|
||||
sep = boxchar vpos HM NoLine prop pretty
|
||||
vsep v = case v of
|
||||
NoLine -> sep ++ sep
|
||||
_ -> sep ++ cross v prop ++ sep
|
||||
NoLine -> sep <> sep
|
||||
_ -> sep <> cross v prop <> sep
|
||||
cross v h = boxchar vpos HM v h pretty
|
||||
|
||||
data VPos = VT | VM | VB -- top middle bottom
|
||||
data HPos = HL | HM | HR -- left middle right
|
||||
|
||||
boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String
|
||||
boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> Builder
|
||||
boxchar vpos hpos vert horiz = lineart u d l r
|
||||
where
|
||||
u =
|
||||
case vpos of
|
||||
u = case vpos of
|
||||
VT -> NoLine
|
||||
_ -> vert
|
||||
d =
|
||||
case vpos of
|
||||
d = case vpos of
|
||||
VB -> NoLine
|
||||
_ -> vert
|
||||
l =
|
||||
case hpos of
|
||||
l = case hpos of
|
||||
HL -> NoLine
|
||||
_ -> horiz
|
||||
r =
|
||||
case hpos of
|
||||
r = case hpos of
|
||||
HR -> NoLine
|
||||
_ -> horiz
|
||||
|
||||
pick :: String -> String -> Bool -> String
|
||||
pick x _ True = x
|
||||
pick _ x False = x
|
||||
pick :: Text -> Text -> Bool -> Builder
|
||||
pick x _ True = fromText x
|
||||
pick _ x False = fromText x
|
||||
|
||||
lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> String
|
||||
lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> Builder
|
||||
-- up down left right
|
||||
lineart SingleLine SingleLine SingleLine SingleLine = pick "┼" "+"
|
||||
lineart SingleLine SingleLine SingleLine NoLine = pick "┤" "+"
|
||||
@ -244,6 +261,4 @@ lineart NoLine SingleLine DoubleLine DoubleLine = pick "╤" "+"
|
||||
lineart SingleLine SingleLine DoubleLine DoubleLine = pick "╪" "+"
|
||||
lineart DoubleLine DoubleLine SingleLine SingleLine = pick "╫" "++"
|
||||
|
||||
lineart _ _ _ _ = const ""
|
||||
|
||||
--
|
||||
lineart _ _ _ _ = const mempty
|
||||
|
||||
@ -255,7 +255,7 @@ module Hledger.Cli.Commands.Balance (
|
||||
) where
|
||||
|
||||
import Data.Default (def)
|
||||
import Data.List (intercalate, transpose)
|
||||
import Data.List (intersperse, transpose)
|
||||
import Data.Maybe (fromMaybe, maybeToList)
|
||||
--import qualified Data.Map as Map
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
@ -263,11 +263,12 @@ import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import Data.Time (fromGregorian)
|
||||
import System.Console.CmdArgs.Explicit as C
|
||||
import Lucid as L
|
||||
import Text.Tabular as T
|
||||
import Text.Tabular.AsciiWide as T
|
||||
import Text.Tabular as Tab
|
||||
import Text.Tabular.AsciiWide as Tab
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
@ -321,16 +322,16 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
assrt = not $ ignore_assertions_ $ inputopts_ opts
|
||||
render = case fmt of
|
||||
"txt" -> budgetReportAsText ropts
|
||||
"json" -> TL.unpack . (<>"\n") . toJsonText
|
||||
"csv" -> TL.unpack . printCSV . budgetReportAsCsv ropts
|
||||
_ -> const $ error' $ unsupportedOutputFormatError fmt
|
||||
writeOutput opts $ render budgetreport
|
||||
"json" -> (<>"\n") . toJsonText
|
||||
"csv" -> printCSV . budgetReportAsCsv ropts
|
||||
_ -> error' $ unsupportedOutputFormatError fmt
|
||||
writeOutputLazyText opts $ render budgetreport
|
||||
|
||||
else
|
||||
if multiperiod then do -- multi period balance report
|
||||
let report = multiBalanceReport rspec j
|
||||
render = case fmt of
|
||||
"txt" -> TL.pack . multiBalanceReportAsText ropts
|
||||
"txt" -> multiBalanceReportAsText ropts
|
||||
"csv" -> printCSV . multiBalanceReportAsCsv ropts
|
||||
"html" -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts
|
||||
"json" -> (<>"\n") . toJsonText
|
||||
@ -340,7 +341,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
else do -- single period simple balance report
|
||||
let report = balanceReport rspec j -- simple Ledger-style balance report
|
||||
render = case fmt of
|
||||
"txt" -> \ropts -> TL.pack . balanceReportAsText ropts
|
||||
"txt" -> \ropts -> TB.toLazyText . balanceReportAsText ropts
|
||||
"csv" -> \ropts -> printCSV . balanceReportAsCsv ropts
|
||||
"json" -> const $ (<>"\n") . toJsonText
|
||||
_ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
@ -363,18 +364,21 @@ balanceReportAsCsv opts (items, total) =
|
||||
else [["total", T.pack $ showMixedAmountOneLineWithoutPrice False total]]
|
||||
|
||||
-- | Render a single-column balance report as plain text.
|
||||
balanceReportAsText :: ReportOpts -> BalanceReport -> String
|
||||
balanceReportAsText opts ((items, total)) = unlines $
|
||||
concat lines ++ if no_total_ opts then [] else overline : totallines
|
||||
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
|
||||
balanceReportAsText opts ((items, total)) =
|
||||
unlinesB lines <> unlinesB (if no_total_ opts then [] else [overline, totallines])
|
||||
where
|
||||
unlinesB [] = mempty
|
||||
unlinesB xs = mconcat (intersperse (TB.singleton '\n') xs) <> TB.singleton '\n'
|
||||
|
||||
lines = map (balanceReportItemAsText opts) items
|
||||
-- abuse renderBalanceReportItem to render the total with similar format
|
||||
acctcolwidth = maximum' [T.length fullname | (fullname, _, _, _) <- items]
|
||||
totallines = map rstrip $ renderBalanceReportItem opts (T.replicate (acctcolwidth+1) " ", 0, total)
|
||||
totallines = renderBalanceReportItem opts ("", 0, total)
|
||||
-- with a custom format, extend the line to the full report width;
|
||||
-- otherwise show the usual 20-char line for compatibility
|
||||
overlinewidth = fromMaybe (maximum' . map length $ concat lines) . overlineWidth $ format_ opts
|
||||
overline = replicate overlinewidth '-'
|
||||
overlinewidth = fromMaybe 22 . overlineWidth $ format_ opts
|
||||
--overlinewidth = fromMaybe (maximum' . map length $ concat lines) . overlineWidth $ format_ opts
|
||||
overline = TB.fromText $ T.replicate overlinewidth "-"
|
||||
|
||||
{-
|
||||
:r
|
||||
@ -391,7 +395,7 @@ This implementation turned out to be a bit convoluted but implements the followi
|
||||
-- whatever string format is specified). Note, prices will not be rendered, and
|
||||
-- differently-priced quantities of the same commodity will appear merged.
|
||||
-- The output will be one or more lines depending on the format and number of commodities.
|
||||
balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> [String]
|
||||
balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> TB.Builder
|
||||
balanceReportItemAsText opts (_, accountName, depth, amt) =
|
||||
renderBalanceReportItem opts (
|
||||
accountName,
|
||||
@ -400,41 +404,45 @@ balanceReportItemAsText opts (_, accountName, depth, amt) =
|
||||
)
|
||||
|
||||
-- | Render a balance report item using the given StringFormat, generating one or more lines of text.
|
||||
renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> [String]
|
||||
renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> TB.Builder
|
||||
renderBalanceReportItem opts (acctname, depth, total) =
|
||||
lines $ case format_ opts of
|
||||
OneLine _ comps -> concatOneLine $ render1 comps
|
||||
TopAligned _ comps -> concatBottomPadded $ render comps
|
||||
BottomAligned _ comps -> concatTopPadded $ render comps
|
||||
case format_ opts of
|
||||
OneLine _ comps -> foldMap (TB.fromText . T.intercalate ", ") $ render1 comps
|
||||
TopAligned _ comps -> renderRow' TopLeft $ render comps
|
||||
BottomAligned _ comps -> renderRow' BottomLeft $ render comps
|
||||
where
|
||||
render1 = map (renderComponent1 opts (acctname, depth, total))
|
||||
render = map (renderComponent opts (acctname, depth, total))
|
||||
renderRow' align = renderRowB def{tableBorders=False, borderSpaces=False}
|
||||
. Tab.Group NoLine . map (Header . cell)
|
||||
where cell = Cell align . map (\x -> (x, textWidth x))
|
||||
|
||||
render1 = map (T.lines . renderComponent1 opts (acctname, depth, total))
|
||||
render = map (T.lines . renderComponent opts (acctname, depth, total))
|
||||
|
||||
-- | Render one StringFormat component for a balance report item.
|
||||
renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
|
||||
renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> T.Text
|
||||
renderComponent _ _ (FormatLiteral s) = s
|
||||
renderComponent opts (acctname, depth, total) (FormatField ljust min max field) = case field of
|
||||
DepthSpacerField -> formatString ljust Nothing max $ replicate d ' '
|
||||
DepthSpacerField -> formatText ljust Nothing max $ T.replicate d " "
|
||||
where d = case min of
|
||||
Just m -> depth * m
|
||||
Nothing -> depth
|
||||
AccountField -> formatString ljust min max (T.unpack acctname)
|
||||
TotalField -> fst $ showMixed showAmountWithoutPrice min max (color_ opts) total
|
||||
AccountField -> formatText ljust min max acctname
|
||||
TotalField -> T.pack . fst $ showMixed showAmountWithoutPrice min max (color_ opts) total
|
||||
_ -> ""
|
||||
|
||||
-- | Render one StringFormat component for a balance report item.
|
||||
-- This variant is for use with OneLine string formats; it squashes
|
||||
-- any multi-line rendered values onto one line, comma-and-space separated,
|
||||
-- while still complying with the width spec.
|
||||
renderComponent1 :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
|
||||
renderComponent1 :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> T.Text
|
||||
renderComponent1 _ _ (FormatLiteral s) = s
|
||||
renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field) = case field of
|
||||
AccountField -> formatString ljust min max ((intercalate ", " . lines) (indented (T.unpack acctname)))
|
||||
AccountField -> formatText ljust min max . T.intercalate ", " . T.lines $ indented acctname
|
||||
where
|
||||
-- better to indent the account name here rather than use a DepthField component
|
||||
-- so that it complies with width spec. Uses a fixed indent step size.
|
||||
indented = ((replicate (depth*2) ' ')++)
|
||||
TotalField -> fst $ showMixedOneLine showAmountWithoutPrice min max (color_ opts) total
|
||||
indented = ((T.replicate (depth*2) " ")<>)
|
||||
TotalField -> T.pack . fst $ showMixedOneLine showAmountWithoutPrice min max (color_ opts) total
|
||||
_ -> ""
|
||||
|
||||
-- rendering multi-column balance reports
|
||||
@ -559,9 +567,11 @@ multiBalanceReportHtmlFootRow ropts (acct:rest) =
|
||||
--thRow = tr_ . mconcat . map (th_ . toHtml)
|
||||
|
||||
-- | Render a multi-column balance report as plain text suitable for console output.
|
||||
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
|
||||
multiBalanceReportAsText ropts@ReportOpts{..} r =
|
||||
T.unpack title <> "\n\n" <> (balanceReportTableAsText ropts $ balanceReportAsTable ropts r)
|
||||
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> TL.Text
|
||||
multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $
|
||||
TB.fromText title
|
||||
<> TB.fromText "\n\n"
|
||||
<> balanceReportTableAsText ropts (balanceReportAsTable ropts r)
|
||||
where
|
||||
title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":"
|
||||
|
||||
@ -584,23 +594,23 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
|
||||
_ -> False
|
||||
|
||||
-- | Build a 'Table' from a multi-column balance report.
|
||||
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
|
||||
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text MixedAmount
|
||||
balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
|
||||
(PeriodicReport spans items (PeriodicReportRow _ coltotals tot avg)) =
|
||||
maybetranspose $
|
||||
addtotalrow $
|
||||
Table
|
||||
(T.Group NoLine $ map Header accts)
|
||||
(T.Group NoLine $ map Header colheadings)
|
||||
(Tab.Group NoLine $ map Header accts)
|
||||
(Tab.Group NoLine $ map Header colheadings)
|
||||
(map rowvals items)
|
||||
where
|
||||
totalscolumn = row_total_ && balancetype_ `notElem` [CumulativeChange, HistoricalBalance]
|
||||
colheadings = map (T.unpack . reportPeriodName balancetype_ spans) spans
|
||||
colheadings = map (reportPeriodName balancetype_ spans) spans
|
||||
++ [" Total" | totalscolumn]
|
||||
++ ["Average" | average_]
|
||||
accts = map renderacct items
|
||||
renderacct row =
|
||||
replicate ((prrDepth row - 1) * 2) ' ' ++ T.unpack (prrDisplayName row)
|
||||
T.replicate ((prrDepth row - 1) * 2) " " <> prrDisplayName row
|
||||
rowvals (PeriodicReportRow _ as rowtot rowavg) = as
|
||||
++ [rowtot | totalscolumn]
|
||||
++ [rowavg | average_]
|
||||
@ -617,12 +627,12 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
|
||||
-- made using 'balanceReportAsTable'), render it in a format suitable for
|
||||
-- console output. Amounts with more than two commodities will be elided
|
||||
-- unless --no-elide is used.
|
||||
balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
|
||||
balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text MixedAmount -> TB.Builder
|
||||
balanceReportTableAsText ReportOpts{..} =
|
||||
T.renderTable def{tableBorders=False, prettyTable=pretty_tables_}
|
||||
(T.alignCell TopLeft) (T.alignCell TopRight) showamt
|
||||
Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_}
|
||||
(Tab.alignCell TopLeft) (Tab.alignCell TopRight) showamt
|
||||
where
|
||||
showamt = Cell TopRight . pure . showMixedOneLine showAmountWithoutPrice Nothing mmax color_
|
||||
showamt = Cell TopRight . (\(a,w) -> [(T.pack a,w)]) . showMixedOneLine showAmountWithoutPrice Nothing mmax color_
|
||||
mmax = if no_elide_ then Nothing else Just 32
|
||||
|
||||
|
||||
@ -631,14 +641,12 @@ tests_Balance = tests "Balance" [
|
||||
tests "balanceReportAsText" [
|
||||
test "unicode in balance layout" $ do
|
||||
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let rspec = defreportspec
|
||||
balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j)
|
||||
let rspec = defreportspec{rsOpts=defreportopts{no_total_=True}}
|
||||
TL.unpack (TB.toLazyText $ balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j))
|
||||
@?=
|
||||
unlines
|
||||
[" -100 актив:наличные"
|
||||
," 100 расходы:покупки"
|
||||
,"--------------------"
|
||||
," 0"
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ParallelListComp #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-|
|
||||
@ -20,6 +21,7 @@ import Data.List
|
||||
import Numeric.RootFinding
|
||||
import Data.Decimal
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import System.Console.CmdArgs.Explicit as CmdArgs
|
||||
|
||||
import Text.Tabular as Tbl
|
||||
@ -126,14 +128,14 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
|
||||
, T.pack $ printf "%0.2f%%" $ smallIsZero twr ]
|
||||
|
||||
let table = Table
|
||||
(Tbl.Group NoLine (map (Header . show) (take (length tableBody) [1..])))
|
||||
(Tbl.Group NoLine (map (Header . T.pack . show) (take (length tableBody) [1..])))
|
||||
(Tbl.Group DoubleLine
|
||||
[ Tbl.Group SingleLine [Header "Begin", Header "End"]
|
||||
, Tbl.Group SingleLine [Header "Value (begin)", Header "Cashflow", Header "Value (end)", Header "PnL"]
|
||||
, Tbl.Group SingleLine [Header "IRR", Header "TWR"]])
|
||||
tableBody
|
||||
|
||||
putStrLn $ Ascii.render prettyTables id id T.unpack table
|
||||
TL.putStrLn $ Ascii.render prettyTables id id id table
|
||||
|
||||
timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow pnl) = do
|
||||
let initialUnitPrice = 100
|
||||
@ -196,7 +198,7 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spa
|
||||
unitBalances = add initialUnits unitBalances'
|
||||
valuesOnDate = add 0 valuesOnDate'
|
||||
|
||||
putStr $ Ascii.render prettyTables T.unpack id id
|
||||
TL.putStr $ Ascii.render prettyTables id id T.pack
|
||||
(Table
|
||||
(Tbl.Group NoLine (map (Header . showDate) dates))
|
||||
(Tbl.Group DoubleLine [ Tbl.Group SingleLine [Header "Portfolio value", Header "Unit balance"]
|
||||
@ -226,11 +228,11 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB
|
||||
when showCashFlow $ do
|
||||
printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
|
||||
let (dates, amounts) = unzip totalCF
|
||||
putStrLn $ Ascii.render prettyTables T.unpack id id
|
||||
TL.putStrLn $ Ascii.render prettyTables id id id
|
||||
(Table
|
||||
(Tbl.Group NoLine (map (Header . showDate) dates))
|
||||
(Tbl.Group SingleLine [Header "Amount"])
|
||||
(map ((:[]) . show) amounts))
|
||||
(map ((:[]) . T.pack . show) amounts))
|
||||
|
||||
-- 0% is always a solution, so require at least something here
|
||||
case totalCF of
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
@ -16,8 +17,12 @@ module Hledger.Cli.CompoundBalanceCommand (
|
||||
|
||||
import Data.List (foldl')
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import Data.Time.Calendar (Day, addDays)
|
||||
import System.Console.CmdArgs.Explicit as C
|
||||
import Hledger.Read.CsvReader (CSV, printCSV)
|
||||
@ -153,7 +158,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r
|
||||
|
||||
-- render appropriately
|
||||
render = case outputFormatFromOpts opts of
|
||||
"txt" -> TL.pack . compoundBalanceReportAsText ropts'
|
||||
"txt" -> compoundBalanceReportAsText ropts'
|
||||
"csv" -> printCSV . compoundBalanceReportAsCsv ropts'
|
||||
"html" -> L.renderText . compoundBalanceReportAsHtml ropts'
|
||||
"json" -> toJsonText
|
||||
@ -189,10 +194,11 @@ Balance Sheet
|
||||
Total || 1 1 1
|
||||
|
||||
-}
|
||||
compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> String
|
||||
compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> TL.Text
|
||||
compoundBalanceReportAsText ropts
|
||||
(CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
|
||||
T.unpack title ++ "\n\n" ++
|
||||
TB.toLazyText $
|
||||
TB.fromText title <> TB.fromText "\n\n" <>
|
||||
balanceReportTableAsText ropts bigtable'
|
||||
where
|
||||
bigtable =
|
||||
@ -218,7 +224,7 @@ compoundBalanceReportAsText ropts
|
||||
-- convert to table
|
||||
Table lefthdrs tophdrs cells = balanceReportAsTable ropts r
|
||||
-- tweak the layout
|
||||
t = Table (Tab.Group SingleLine [Header $ T.unpack title, lefthdrs]) tophdrs ([]:cells)
|
||||
t = Table (Tab.Group SingleLine [Header title, lefthdrs]) tophdrs ([]:cells)
|
||||
|
||||
-- | Add the second table below the first, discarding its column headings.
|
||||
concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
|
||||
|
||||
@ -31,7 +31,7 @@ hledger -f - register
|
||||
>>>=0
|
||||
|
||||
# 3. balance
|
||||
hledger -f - balance
|
||||
hledger -f - balance -N
|
||||
<<<
|
||||
2010/1/1
|
||||
a EUR 1 ; a euro
|
||||
@ -42,8 +42,6 @@ hledger -f - balance
|
||||
USD 1 b
|
||||
EUR -1
|
||||
USD -1 c
|
||||
--------------------
|
||||
0
|
||||
>>>=0
|
||||
|
||||
# 4. a single-commodity zero amount's commodity/decimal places/price is preserved, when possible
|
||||
@ -63,7 +61,7 @@ hledger -f- print --explicit --empty
|
||||
# When preserving a zero amount's commodity, we should also preserve
|
||||
# the amount style, such as where to place the symbol.
|
||||
# https://github.com/simonmichael/hledger/issues/230
|
||||
hledger -f- balance --tree
|
||||
hledger -f- balance --tree -N
|
||||
<<<
|
||||
D 1000,00€
|
||||
|
||||
@ -79,8 +77,6 @@ D 1000,00€
|
||||
4000,58€ 1
|
||||
-1000,58€ D
|
||||
-3000,00€ e
|
||||
--------------------
|
||||
0
|
||||
>>>= 0
|
||||
|
||||
|
||||
|
||||
@ -16,22 +16,18 @@
|
||||
1 -1
|
||||
|
||||
# 1. simple balance report in tree mode with zero/boring parents
|
||||
$ hledger -f - bal --tree
|
||||
$ hledger -f - bal --tree -N
|
||||
0 1:2
|
||||
1 3
|
||||
0 4
|
||||
1 5
|
||||
--------------------
|
||||
0
|
||||
|
||||
# 2. simple balance report in flat mode
|
||||
$ hledger -f - bal --flat
|
||||
$ hledger -f - bal --flat -N
|
||||
-1 1:2
|
||||
1 1:2:3
|
||||
-1 1:2:3:4
|
||||
1 1:2:3:4:5
|
||||
--------------------
|
||||
0
|
||||
|
||||
# 3. tabular balance report in flat mode
|
||||
$ hledger -f - bal -Y
|
||||
|
||||
@ -27,7 +27,7 @@ hledger -f sample.journal balance --tree o
|
||||
>>>=0
|
||||
|
||||
# 3. Period reporting works for a specific year
|
||||
hledger -f - balance -b 2016 -e 2017
|
||||
hledger -f - balance -b 2016 -e 2017 -N
|
||||
<<<
|
||||
2015/10/10 Client A | Invoice #1
|
||||
assets:receivables $10,000.00
|
||||
@ -52,13 +52,11 @@ hledger -f - balance -b 2016 -e 2017
|
||||
$-40.00 assets:checking
|
||||
$50.00 expense:hosting
|
||||
$-10.00 revenue:clients:B
|
||||
--------------------
|
||||
0
|
||||
>>>2
|
||||
>>>= 0
|
||||
|
||||
# 4. Period reporting works for two years
|
||||
hledger -f - balance --tree -b 2015 -e 2017
|
||||
hledger -f - balance --tree -b 2015 -e 2017 -N
|
||||
<<<
|
||||
2015/10/10 Client A | Invoice #1
|
||||
assets:receivables $10,000.00
|
||||
@ -85,13 +83,11 @@ hledger -f - balance --tree -b 2015 -e 2017
|
||||
$-10,010.00 revenue:clients
|
||||
$-10,000.00 A
|
||||
$-10.00 B
|
||||
--------------------
|
||||
0
|
||||
>>>2
|
||||
>>>= 0
|
||||
|
||||
# 5. Period reporting works for one month
|
||||
hledger -f - balance --tree -b 2015/11 -e 2015/12
|
||||
hledger -f - balance --tree -b 2015/11 -e 2015/12 -N
|
||||
<<<
|
||||
2015/10/10 Client A | Invoice #1
|
||||
assets:receivables $10,000.00
|
||||
@ -116,8 +112,6 @@ hledger -f - balance --tree -b 2015/11 -e 2015/12
|
||||
0 assets
|
||||
$10,000.00 checking
|
||||
$-10,000.00 receivables
|
||||
--------------------
|
||||
0
|
||||
>>>2
|
||||
>>>= 0
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
hledger -f - balance -p 'in 2009' --date2
|
||||
hledger -f - balance -p 'in 2009' --date2 -N
|
||||
<<<
|
||||
2009/1/1 x
|
||||
a 1
|
||||
@ -10,6 +10,4 @@ hledger -f - balance -p 'in 2009' --date2
|
||||
>>>
|
||||
1 a
|
||||
-1 b
|
||||
--------------------
|
||||
0
|
||||
>>>=0
|
||||
|
||||
Loading…
Reference in New Issue
Block a user