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