{-|

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.List (intersperse)
import Data.Maybe (fromMaybe, isJust)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
-- import Data.Text (Text)
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
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils

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
    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] -> Builder) -> [Builder] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
unlinesB ([Builder] -> Text) -> [Builder] -> Text
forall a b. (a -> b) -> a -> b
$
      (PostingsReportItem -> Builder) -> PostingsReport -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (CliOpts -> Int -> Int -> PostingsReportItem -> Builder
postingsReportItemAsText CliOpts
opts Int
amtwidth Int
balwidth) PostingsReport
items
  where
    amtwidth :: Int
amtwidth = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (PostingsReportItem -> Int) -> PostingsReport -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (PostingsReportItem -> WideBuilder) -> PostingsReportItem -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> WideBuilder
showAmt (MixedAmount -> WideBuilder)
-> (PostingsReportItem -> MixedAmount)
-> PostingsReportItem
-> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ (PostingsReportItem -> Int) -> PostingsReport -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (PostingsReportItem -> WideBuilder) -> PostingsReportItem -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> WideBuilder
showAmt (MixedAmount -> WideBuilder)
-> (PostingsReportItem -> MixedAmount)
-> PostingsReportItem
-> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReportItem -> MixedAmount
forall a b c d e. (a, b, c, d, e) -> e
itembal) PostingsReport
items
    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
    showAmt :: MixedAmount -> WideBuilder
showAmt = AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour{displayMinWidth :: Maybe Int
displayMinWidth=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
12}

-- | 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.
--
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> TB.Builder
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> Builder
postingsReportItemAsText CliOpts
opts Int
preferredamtwidth Int
preferredbalwidth (Maybe Day
mdate, Maybe Day
menddate, Maybe CsvValue
mdesc, Posting
p, MixedAmount
b) =
  -- use elide*Width to be wide-char-aware
  -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
  (CsvValue -> Builder) -> [CsvValue] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CsvValue -> Builder
TB.fromText ([CsvValue] -> Builder) -> (CSV -> [CsvValue]) -> CSV -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> [CsvValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (CSV -> [CsvValue]) -> (CSV -> CSV) -> CSV -> [CsvValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvValue] -> CSV -> CSV
forall a. a -> [a] -> [a]
intersperse ([CsvValue
"\n"]) (CSV -> Builder) -> CSV -> Builder
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
    , CsvValue
" "
    , 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
    , CsvValue
"  "
    , 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
    , CsvValue
"  "
    , CsvValue
amtfirstline
    , CsvValue
"  "
    , CsvValue
balfirstline
    ]
    [CsvValue] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
    [ [ CsvValue
spacer, CsvValue
a, CsvValue
"  ", CsvValue
b ] | (CsvValue
a,CsvValue
b) <- [CsvValue] -> [CsvValue] -> [(CsvValue, CsvValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CsvValue]
amtrest [CsvValue]
balrest ]
    where
      -- 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
s -> CsvValue -> CsvValue -> CsvValue -> CsvValue
forall a. Semigroup a => a -> a -> a -> a
wrap CsvValue
"[" CsvValue
"]" CsvValue
s, Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
              PostingType
VirtualPosting         -> (\CsvValue
s -> CsvValue -> CsvValue -> CsvValue -> CsvValue
forall a. Semigroup a => a -> a -> a -> a
wrap CsvValue
"(" CsvValue
")" CsvValue
s, Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
              PostingType
_                      -> (CsvValue -> CsvValue
forall a. a -> a
id,Int
acctwidth)
          wrap :: a -> a -> a -> a
wrap a
a a
b a
x = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b
      amt :: CsvValue
amt = Text -> CsvValue
TL.toStrict (Text -> CsvValue)
-> (MixedAmount -> Text) -> MixedAmount -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text)
-> (MixedAmount -> Builder) -> MixedAmount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> Builder
wbBuilder (WideBuilder -> Builder)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MixedAmount -> WideBuilder
showamt Int
amtwidth (MixedAmount -> CsvValue) -> MixedAmount -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
      bal :: CsvValue
bal = Text -> CsvValue
TL.toStrict (Text -> CsvValue)
-> (WideBuilder -> Text) -> WideBuilder -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text)
-> (WideBuilder -> Builder) -> WideBuilder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> Builder
wbBuilder (WideBuilder -> CsvValue) -> WideBuilder -> CsvValue
forall a b. (a -> b) -> a -> b
$ Int -> MixedAmount -> WideBuilder
showamt Int
balwidth MixedAmount
b
      showamt :: Int -> MixedAmount -> WideBuilder
showamt Int
w = AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noPrice{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, displayMinWidth :: Maybe Int
displayMinWidth=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w, displayMaxWidth :: Maybe Int
displayMaxWidth=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w}
      -- alternate behaviour, show null amounts as 0 instead of blank
      -- amt = if null amt' then "0" else amt'
      -- bal = if null bal' then "0" else bal'
      ([CsvValue]
amtlines, [CsvValue]
ballines) = (CsvValue -> [CsvValue]
T.lines CsvValue
amt, CsvValue -> [CsvValue]
T.lines CsvValue
bal)
      (Int
amtlen, Int
ballen) = ([CsvValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CsvValue]
amtlines, [CsvValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CsvValue]
ballines)
      numlines :: Int
numlines = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
amtlen Int
ballen)
      (CsvValue
amtfirstline:[CsvValue]
amtrest) = Int -> [CsvValue] -> [CsvValue]
forall a. Int -> [a] -> [a]
take Int
numlines ([CsvValue] -> [CsvValue]) -> [CsvValue] -> [CsvValue]
forall a b. (a -> b) -> a -> b
$ [CsvValue]
amtlines [CsvValue] -> [CsvValue] -> [CsvValue]
forall a. [a] -> [a] -> [a]
++ CsvValue -> [CsvValue]
forall a. a -> [a]
repeat (Int -> CsvValue -> CsvValue
T.replicate Int
amtwidth CsvValue
" ") -- posting amount is top-aligned
      (CsvValue
balfirstline:[CsvValue]
balrest) = Int -> [CsvValue] -> [CsvValue]
forall a. Int -> [a] -> [a]
take Int
numlines ([CsvValue] -> [CsvValue]) -> [CsvValue] -> [CsvValue]
forall a b. (a -> b) -> a -> b
$ Int -> CsvValue -> [CsvValue]
forall a. Int -> a -> [a]
replicate (Int
numlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ballen) (Int -> CsvValue -> CsvValue
T.replicate Int
balwidth CsvValue
" ") [CsvValue] -> [CsvValue] -> [CsvValue]
forall a. [a] -> [a] -> [a]
++ [CsvValue]
ballines -- balance amount is bottom-aligned
      spacer :: CsvValue
spacer = Int -> CsvValue -> CsvValue
T.replicate (Int
totalwidth 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)) CsvValue
" "

-- 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"]
   ]

 ]