{-|

A ledger-compatible @register@ command.

-}

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

module Hledger.Cli.Commands.Register (
  registermode
 ,register
 ,postingsReportAsText
 ,postingsReportItemAsText
 -- ,showPostingWithBalanceForVty
 ,tests_Register
) where

import Data.Default (def)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import System.Console.CmdArgs.Explicit (flagNone, flagReq)
import Safe (maximumDef)

import Hledger
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Text.Tabular.AsciiWide

registermode :: Mode RawOpts
registermode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Register.txt")
  ([[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"cumulative"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"cumulative")
     CommandDoc
"show running total from report start date (default)"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"historical",CommandDoc
"H"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"historical")
     CommandDoc
"show historical running total/balance (includes postings before report start date)\n "
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"average",CommandDoc
"A"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"average")
     CommandDoc
"show running average of posting amounts instead of total (implies --empty)"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"related",CommandDoc
"r"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"related") CommandDoc
"show postings' siblings instead"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"invert"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"invert") CommandDoc
"display all amounts with reversed sign"
  ,[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq  [CommandDoc
"width",CommandDoc
"w"] (\CommandDoc
s RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt CommandDoc
"width" CommandDoc
s RawOpts
opts) CommandDoc
"N"
     (CommandDoc
"set output width (default: " CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
#ifdef mingw32_HOST_OS
      show defaultWidth
#else
      CommandDoc
"terminal width"
#endif
      CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
" or $COLUMNS). -wN,M sets description width as well."
     )
  ,[CommandDoc] -> Flag RawOpts
outputFormatFlag [CommandDoc
"txt",CommandDoc
"csv",CommandDoc
"json"]
  ,Flag RawOpts
outputFileFlag
  ])
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")

-- | Print a (posting) register report.
register :: CliOpts -> Journal -> IO ()
register :: CliOpts -> Journal -> IO ()
register opts :: CliOpts
opts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j =
    CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts (Text -> IO ())
-> (PostingsReport -> Text) -> PostingsReport -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> Text
render (PostingsReport -> IO ()) -> PostingsReport -> IO ()
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j
  where
    fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
    render :: PostingsReport -> Text
render | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"txt"  = CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts
           | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"csv"  = CSV -> Text
printCSV (CSV -> Text) -> (PostingsReport -> CSV) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> CSV
postingsReportAsCsv
           | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"json" = PostingsReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
           | Bool
otherwise   = CommandDoc -> PostingsReport -> Text
forall a. CommandDoc -> a
error' (CommandDoc -> PostingsReport -> Text)
-> CommandDoc -> PostingsReport -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt  -- PARTIAL:

postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv PostingsReport
is =
  [CsvValue
"txnidx",CsvValue
"date",CsvValue
"code",CsvValue
"description",CsvValue
"account",CsvValue
"amount",CsvValue
"total"]
  [CsvValue] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
  (PostingsReportItem -> [CsvValue]) -> PostingsReport -> CSV
forall a b. (a -> b) -> [a] -> [b]
map PostingsReportItem -> [CsvValue]
postingsReportItemAsCsvRecord PostingsReport
is

postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
postingsReportItemAsCsvRecord :: PostingsReportItem -> [CsvValue]
postingsReportItemAsCsvRecord (Maybe Day
_, Maybe Day
_, Maybe CsvValue
_, Posting
p, MixedAmount
b) = [CsvValue
idx,CsvValue
date,CsvValue
code,CsvValue
desc,CsvValue
acct,CsvValue
amt,CsvValue
bal]
  where
    idx :: CsvValue
idx  = CommandDoc -> CsvValue
T.pack (CommandDoc -> CsvValue)
-> (Maybe Transaction -> CommandDoc)
-> Maybe Transaction
-> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Integer -> CommandDoc)
-> (Maybe Transaction -> Integer)
-> Maybe Transaction
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Transaction -> Integer) -> Maybe Transaction -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Transaction -> Integer
tindex (Maybe Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    date :: CsvValue
date = Day -> CsvValue
showDate (Day -> CsvValue) -> Day -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p -- XXX csv should show date2 with --date2
    code :: CsvValue
code = CsvValue
-> (Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvValue
"" Transaction -> CsvValue
tcode (Maybe Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    desc :: CsvValue
desc = CsvValue
-> (Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvValue
"" Transaction -> CsvValue
tdescription (Maybe Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    acct :: CsvValue
acct = CsvValue -> CsvValue
bracket (CsvValue -> CsvValue) -> CsvValue -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> CsvValue
paccount Posting
p
      where
        bracket :: CsvValue -> CsvValue
bracket = case Posting -> PostingType
ptype Posting
p of
                             PostingType
BalancedVirtualPosting -> CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"[" CsvValue
"]"
                             PostingType
VirtualPosting -> CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"(" CsvValue
")"
                             PostingType
_ -> CsvValue -> CsvValue
forall a. a -> a
id
    -- Since postingsReport strips prices from all Amounts when not used, we can display prices.
    amt :: CsvValue
amt = WideBuilder -> CsvValue
wbToText (WideBuilder -> CsvValue)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine (MixedAmount -> CsvValue) -> MixedAmount -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
    bal :: CsvValue
bal = WideBuilder -> CsvValue
wbToText (WideBuilder -> CsvValue) -> WideBuilder -> CsvValue
forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine MixedAmount
b

-- | Render a register report as plain text suitable for console output.
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
postingsReportAsText :: CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts PostingsReport
items = Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ ((Builder, Int, Int) -> Builder)
-> [(Builder, Int, Int)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder, Int, Int) -> Builder
forall a b c. (a, b, c) -> a
first3 [(Builder, Int, Int)]
linesWithWidths
  where
    linesWithWidths :: [(Builder, Int, Int)]
linesWithWidths = (PostingsReportItem -> (Builder, Int, Int))
-> PostingsReport -> [(Builder, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (CliOpts -> Int -> Int -> PostingsReportItem -> (Builder, Int, Int)
postingsReportItemAsText CliOpts
opts Int
amtwidth Int
balwidth) PostingsReport
items
    -- Tying this knot seems like it will save work, but ends up creating a big
    -- space leak. Can we fix that leak without recalculating everything?
    -- amtwidth = maximum $ 12 : map second3 linesWithWidths
    -- balwidth = maximum $ 12 : map third3 linesWithWidths
    amtwidth :: Int
amtwidth = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [MixedAmount] -> [Int]
widths ((PostingsReportItem -> MixedAmount)
-> PostingsReport -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map PostingsReportItem -> MixedAmount
forall a b c e. (a, b, c, Posting, e) -> MixedAmount
itemamt PostingsReport
items)
    balwidth :: Int
balwidth = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [MixedAmount] -> [Int]
widths ((PostingsReportItem -> MixedAmount)
-> PostingsReport -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map PostingsReportItem -> MixedAmount
forall a b c d e. (a, b, c, d, e) -> e
itembal PostingsReport
items)
    -- Since postingsReport strips prices from all Amounts when not used, we can display prices.
    widths :: [MixedAmount] -> [Int]
widths = (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth ([WideBuilder] -> [Int])
-> ([MixedAmount] -> [WideBuilder]) -> [MixedAmount] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MixedAmount -> [WideBuilder]) -> [MixedAmount] -> [WideBuilder]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AmountDisplayOpts -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB AmountDisplayOpts
oneLine)
    itemamt :: (a, b, c, Posting, e) -> MixedAmount
itemamt (a
_,b
_,c
_,Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
a},e
_) = MixedAmount
a
    itembal :: (a, b, c, d, e) -> e
itembal (a
_,b
_,c
_,d
_,e
a) = e
a

-- | Render one register report line item as plain text. Layout is like so:
-- @
-- <---------------- width (specified, terminal width, or 80) -------------------->
-- date (10)  description           account              amount (12)   balance (12)
-- DDDDDDDDDD dddddddddddddddddddd  aaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
-- @
-- If description's width is specified, account will use the remaining space.
-- Otherwise, description and account divide up the space equally.
--
-- With a report interval, the layout is like so:
-- @
-- <---------------- width (specified, terminal width, or 80) -------------------->
-- date (21)              account                        amount (12)   balance (12)
-- DDDDDDDDDDDDDDDDDDDDD  aaaaaaaaaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
-- @
--
-- date and description are shown for the first posting of a transaction only.
--
-- Returns a string which can be multi-line, eg if the running balance
-- has multiple commodities. Does not yet support formatting control
-- like balance reports.
--
-- Also returns the natural width (without padding) of the amount and balance
-- fields.
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> (TB.Builder, Int, Int)
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> (Builder, Int, Int)
postingsReportItemAsText CliOpts
opts Int
preferredamtwidth Int
preferredbalwidth (Maybe Day
mdate, Maybe Day
menddate, Maybe CsvValue
mdesc, Posting
p, MixedAmount
b) =
    (Builder
table Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n', Int
thisamtwidth, Int
thisbalwidth)
  where
    table :: Builder
table = TableOpts -> Header Cell -> Builder
renderRowB TableOpts
forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False} (Header Cell -> Builder)
-> ([Header Cell] -> Header Cell) -> [Header Cell] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Builder) -> [Header Cell] -> Builder
forall a b. (a -> b) -> a -> b
$ (Cell -> Header Cell) -> [Cell] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Header Cell
forall h. h -> Header h
Header
      [ Align -> CsvValue -> Cell
textCell Align
TopLeft (CsvValue -> Cell) -> CsvValue -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) Bool
True Bool
True CsvValue
date
      , Cell
spacerCell
      , Align -> CsvValue -> Cell
textCell Align
TopLeft (CsvValue -> Cell) -> CsvValue -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) Bool
True Bool
True CsvValue
desc
      , Cell
spacerCell2
      , Align -> CsvValue -> Cell
textCell Align
TopLeft (CsvValue -> Cell) -> CsvValue -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctwidth) Bool
True Bool
True CsvValue
acct
      , Cell
spacerCell2
      , Align -> [WideBuilder] -> Cell
Cell Align
TopRight ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> WideBuilder) -> [WideBuilder] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> WideBuilder -> WideBuilder
pad Int
amtwidth) [WideBuilder]
amt
      , Cell
spacerCell2
      , Align -> [WideBuilder] -> Cell
Cell Align
BottomRight ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> WideBuilder) -> [WideBuilder] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> WideBuilder -> WideBuilder
pad Int
balwidth) [WideBuilder]
bal
      ]
    spacerCell :: Cell
spacerCell  = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
' ') Int
1]
    spacerCell2 :: Cell
spacerCell2 = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [Builder -> Int -> WideBuilder
WideBuilder (CommandDoc -> Builder
TB.fromString CommandDoc
"  ") Int
2]
    pad :: Int -> WideBuilder -> WideBuilder
pad Int
fullwidth WideBuilder
amt = Builder -> Int -> WideBuilder
WideBuilder (CsvValue -> Builder
TB.fromText (CsvValue -> Builder) -> CsvValue -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> CsvValue -> CsvValue
T.replicate Int
w CsvValue
" ") Int
w WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
amt
      where w :: Int
w = Int
fullwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
amt
    -- calculate widths
    (Int
totalwidth,Maybe Int
mdescwidth) = CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts
opts
    (Int
datewidth, CsvValue
date) = case (Maybe Day
mdate,Maybe Day
menddate) of
        (Just Day
_, Just Day
_)   -> (Int
21, DateSpan -> CsvValue
showDateSpan (Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
mdate Maybe Day
menddate))
        (Maybe Day
Nothing, Just Day
_)  -> (Int
21, CsvValue
"")
        (Just Day
d, Maybe Day
Nothing)  -> (Int
10, Day -> CsvValue
showDate Day
d)
        (Maybe Day, Maybe Day)
_                  -> (Int
10, CsvValue
"")
    (Int
amtwidth, Int
balwidth)
      | Int
shortfall Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Int
preferredamtwidth, Int
preferredbalwidth)
      | Bool
otherwise      = (Int
adjustedamtwidth, Int
adjustedbalwidth)
      where
        mincolwidth :: Int
mincolwidth = Int
2 -- columns always show at least an ellipsis
        maxamtswidth :: Int
maxamtswidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
totalwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
datewidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mincolwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mincolwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        shortfall :: Int
shortfall = (Int
preferredamtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
preferredbalwidth) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxamtswidth
        amtwidthproportion :: Double
amtwidthproportion = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
preferredamtwidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
preferredamtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
preferredbalwidth)
        adjustedamtwidth :: Int
adjustedamtwidth = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
amtwidthproportion Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxamtswidth
        adjustedbalwidth :: Int
adjustedbalwidth = Int
maxamtswidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
adjustedamtwidth

    remaining :: Int
remaining = Int
totalwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
datewidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
balwidth)
    (Int
descwidth, Int
acctwidth)
      | Bool
hasinterval = (Int
0, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
      | Bool
otherwise   = (Int
w, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
      where
        hasinterval :: Bool
hasinterval = Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust Maybe Day
menddate
        w :: Int
w = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ((Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Maybe Int
mdescwidth

    -- gather content
    desc :: CsvValue
desc = CsvValue -> Maybe CsvValue -> CsvValue
forall a. a -> Maybe a -> a
fromMaybe CsvValue
"" Maybe CsvValue
mdesc
    acct :: CsvValue
acct = CsvValue -> CsvValue
parenthesise (CsvValue -> CsvValue)
-> (CsvValue -> CsvValue) -> CsvValue -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CsvValue -> CsvValue
elideAccountName Int
awidth (CsvValue -> CsvValue) -> CsvValue -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> CsvValue
paccount Posting
p
      where
        (CsvValue -> CsvValue
parenthesise, Int
awidth) = case Posting -> PostingType
ptype Posting
p of
            PostingType
BalancedVirtualPosting -> (CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"[" CsvValue
"]", Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
            PostingType
VirtualPosting         -> (CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"(" CsvValue
")", Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
            PostingType
_                      -> (CsvValue -> CsvValue
forall a. a -> a
id,Int
acctwidth)
    amt :: [WideBuilder]
amt = MixedAmount -> [WideBuilder]
showamt (MixedAmount -> [WideBuilder]) -> MixedAmount -> [WideBuilder]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
    bal :: [WideBuilder]
bal = MixedAmount -> [WideBuilder]
showamt MixedAmount
b
    showamt :: MixedAmount -> [WideBuilder]
showamt = AmountDisplayOpts -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB AmountDisplayOpts
oneLine{displayColour :: Bool
displayColour=ReportOpts -> Bool
color_ (ReportOpts -> Bool)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
rsOpts (ReportSpec -> Bool) -> ReportSpec -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts}
    -- Since this will usually be called with the knot tied between this(amt|bal)width and
    -- preferred(amt|bal)width, make sure the former do not depend on the latter to avoid loops.
    thisamtwidth :: Int
thisamtwidth = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth [WideBuilder]
amt
    thisbalwidth :: Int
thisbalwidth = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
maximumDef Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth [WideBuilder]
bal

-- tests

tests_Register :: TestTree
tests_Register = CommandDoc -> [TestTree] -> TestTree
tests CommandDoc
"Register" [

   CommandDoc -> [TestTree] -> TestTree
tests CommandDoc
"postingsReportAsText" [
    CommandDoc -> IO () -> TestTree
test CommandDoc
"unicode in register layout" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Journal
j <- CsvValue -> IO Journal
readJournal' CsvValue
"2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
      let rspec :: ReportSpec
rspec = ReportSpec
defreportspec
      (Text -> CommandDoc
TL.unpack (Text -> CommandDoc)
-> (PostingsReport -> Text) -> PostingsReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
defcliopts (PostingsReport -> CommandDoc) -> PostingsReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j)
        CommandDoc -> CommandDoc -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        [CommandDoc] -> CommandDoc
unlines
        [CommandDoc
"2009-01-01 медвежья шкура       расходы:покупки                100           100"
        ,CommandDoc
"                                актив:наличные                -100             0"]
   ]

 ]