{-|

The @aregister@ command lists a single account's transactions,
like the account register in hledger-ui and hledger-web,
and unlike the register command which lists postings across multiple accounts.

-}

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

module Hledger.Cli.Commands.Aregister (
  aregistermode
 ,aregister
 -- ,showPostingWithBalanceForVty
 ,tests_Aregister
) where

import Data.Default (def)
import Data.List (find)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Lucid as L hiding (value_)
import System.Console.CmdArgs.Explicit (flagNone, flagReq)

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

aregistermode :: Mode RawOpts
aregistermode = String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Aregister.txt")
  ([
   forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"txn-dates"] (String -> RawOpts -> RawOpts
setboolopt String
"txn-dates") 
     String
"filter strictly by transaction date, not posting date. Warning: this can show a wrong running balance."
   ,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"no-elide"] (String -> RawOpts -> RawOpts
setboolopt String
"no-elide") String
"don't show only 2 commodities per amount"
  --  flagNone ["cumulative"] (setboolopt "cumulative")
  --    "show running total from report start date (default)"
  -- ,flagNone ["historical","H"] (setboolopt "historical")
  --    "show historical running total/balance (includes postings before report start date)\n "
  -- ,flagNone ["average","A"] (setboolopt "average")
  --    "show running average of posting amounts instead of total (implies --empty)"
  -- ,flagNone ["related","r"] (setboolopt "related") "show postings' siblings instead"
  -- ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign"
  ,forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"width",String
"w"] (\String
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"width" String
s RawOpts
opts) String
"N"
     (String
"set output width (default: " forall a. [a] -> [a] -> [a]
++
#ifdef mingw32_HOST_OS
      show defaultWidth
#else
      String
"terminal width"
#endif
      forall a. [a] -> [a] -> [a]
++ String
" or $COLUMNS). -wN,M sets description width as well."
     )
  ,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"align-all"] (String -> RawOpts -> RawOpts
setboolopt String
"align-all") String
"guarantee alignment across all lines (slower)"
  ,[String] -> Flag RawOpts
outputFormatFlag [String
"txt",String
"html",String
"csv",String
"json"]
  ,Flag RawOpts
outputFileFlag
  ])
  [(String, [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Arg RawOpts
argsFlag String
"ACCTPAT [QUERY]")

-- based on Hledger.UI.RegisterScreen:

-- | Print an account register report for a specified account.
aregister :: CliOpts -> Journal -> IO ()
aregister :: CliOpts -> Journal -> IO ()
aregister opts :: CliOpts
opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts,reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = do
  -- the first argument specifies the account, any remaining arguments are a filter query
  let help :: String
help = String
"aregister needs an ACCTPAT argument to select an account"
  (String
apat,[Text]
querystr) <- case String -> RawOpts -> [String]
listofstringopt String
"args" RawOpts
rawopts of
      []     -> forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
help forall a. Semigroup a => a -> a -> a
<> String
".\nPlease provide an account name or a (case-insensitive, infix, regexp) pattern."
      (String
a:[String]
as) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
a, forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
as)
  let
    -- keep synced with accounts --find
    acct :: Text
acct = forall a. a -> Maybe a -> a
fromMaybe (forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
help forall a. Semigroup a => a -> a -> a
<> String
",\nbut " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
apatforall a. [a] -> [a] -> [a]
++String
" did not match any account.")   -- PARTIAL:
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
firstMatch forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalAccountNamesDeclaredOrImplied Journal
j
    firstMatch :: [Text] -> Maybe Text
firstMatch = case Text -> Either String Regexp
toRegexCI forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
apat of
        Right Regexp
re -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Regexp -> Text -> Bool
regexMatchText Regexp
re)
        Left  String
_  -> forall a b. a -> b -> a
const forall a. Maybe a
Nothing
    -- gather report options
    inclusive :: Bool
inclusive = Bool
True  -- tree_ ropts
    thisacctq :: Query
thisacctq = Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ (if Bool
inclusive then Text -> Regexp
accountNameToAccountRegex else Text -> Regexp
accountNameToAccountOnlyRegex) Text
acct
    ropts' :: ReportOpts
ropts' = (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) {
        -- ignore any depth limit, as in postingsReport; allows register's total to match balance reports (cf #1468)
        depth_ :: Maybe Int
depth_=forall a. Maybe a
Nothing
        -- always show historical balance
      , balanceaccum_ :: BalanceAccumulation
balanceaccum_= BalanceAccumulation
Historical
      , querystring_ :: [Text]
querystring_ = [Text]
querystr
      }
    wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
ropts'
  -- and regenerate the ReportSpec, making sure to use the above
  ReportSpec
rspec' <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ReportOpts -> ReportSpec -> Either String ReportSpec
updateReportSpec ReportOpts
ropts' ReportSpec
rspec
  let
    -- run the report
    -- TODO: need to also pass the queries so we can choose which date to render - move them into the report ?
    items :: AccountTransactionsReport
items = ReportSpec -> Journal -> Query -> AccountTransactionsReport
accountTransactionsReport ReportSpec
rspec' Journal
j Query
thisacctq
    items' :: AccountTransactionsReport
items' = (if ReportOpts -> Bool
empty_ ReportOpts
ropts' then forall a. a -> a
id else forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> e
fifth6)) forall a b. (a -> b) -> a -> b
$
             forall a. [a] -> [a]
reverse AccountTransactionsReport
items
    -- select renderer
    render :: AccountTransactionsReport -> Text
render | String
fmtforall a. Eq a => a -> a -> Bool
==String
"txt"  = CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsText CliOpts
opts (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtforall a. Eq a => a -> a -> Bool
==String
"html" = CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsHTML CliOpts
opts (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtforall a. Eq a => a -> a -> Bool
==String
"csv"  = CSV -> Text
printCSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv WhichDate
wd (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtforall a. Eq a => a -> a -> Bool
==String
"json" = forall a. ToJSON a => a -> Text
toJsonText
           | Bool
otherwise   = forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String -> String
unsupportedOutputFormatError String
fmt  -- PARTIAL:
      where
        fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts

  CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts forall a b. (a -> b) -> a -> b
$ AccountTransactionsReport -> Text
render AccountTransactionsReport
items'

accountTransactionsReportAsCsv :: WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv :: WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv WhichDate
wd Query
reportq Query
thisacctq AccountTransactionsReport
is =
  [Text
"txnidx",Text
"date",Text
"code",Text
"description",Text
"otheraccounts",Text
"change",Text
"balance"]
  forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (WhichDate
-> Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Text]
accountTransactionsReportItemAsCsvRecord WhichDate
wd Query
reportq Query
thisacctq) AccountTransactionsReport
is

accountTransactionsReportItemAsCsvRecord :: WhichDate -> Query -> Query -> AccountTransactionsReportItem -> CsvRecord
accountTransactionsReportItemAsCsvRecord :: WhichDate
-> Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Text]
accountTransactionsReportItemAsCsvRecord
  WhichDate
wd Query
reportq Query
thisacctq
  (t :: Transaction
t@Transaction{Integer
tindex :: Transaction -> Integer
tindex :: Integer
tindex,Text
tcode :: Transaction -> Text
tcode :: Text
tcode,Text
tdescription :: Transaction -> Text
tdescription :: Text
tdescription}, Transaction
_, Bool
_issplit, Text
otheracctsstr, MixedAmount
change, MixedAmount
balance)
  = [Text
idx,Text
date,Text
tcode,Text
tdescription,Text
otheracctsstr,Text
amt,Text
bal]
  where
    idx :: Text
idx  = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
tindex
    date :: Text
date = Day -> Text
showDate forall a b. (a -> b) -> a -> b
$ WhichDate -> Query -> Query -> Transaction -> Day
transactionRegisterDate WhichDate
wd Query
reportq Query
thisacctq Transaction
t
    amt :: Text
amt  = WideBuilder -> Text
wbToText forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay MixedAmount
change
    bal :: Text
bal  = WideBuilder -> Text
wbToText forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay MixedAmount
balance

-- | Render a register report as a HTML snippet.
accountTransactionsReportAsHTML :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text
accountTransactionsReportAsHTML :: CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsHTML CliOpts
copts Query
reportq Query
thisacctq AccountTransactionsReport
items =
    forall a. Html a -> Text
L.renderText forall a b. (a -> b) -> a -> b
$ forall arg result. Term arg result => arg -> result
L.table_ (do forall arg result. Term arg result => arg -> result
L.thead_ (forall arg result. Term arg result => arg -> result
L.tr_ (do forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"date"
                                                    forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"description"
                                                    forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"otheraccounts"
                                                    forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"change"
                                                    forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"balance"))
                                forall arg result. Term arg result => arg -> result
L.tbody_ (forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (CliOpts
-> Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> HtmlT Identity ()
htmlRow CliOpts
copts Query
reportq Query
thisacctq) AccountTransactionsReport
items)))

-- | Render one account register report line item as a HTML table row snippet.
htmlRow :: CliOpts -> Query -> Query -> AccountTransactionsReportItem -> L.Html ()
htmlRow :: CliOpts
-> Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> HtmlT Identity ()
htmlRow CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts}} Query
reportq Query
thisacctq
    (t :: Transaction
t@Transaction{Text
tdescription :: Text
tdescription :: Transaction -> Text
tdescription}, Transaction
_, Bool
_issplit, Text
otheracctsstr, MixedAmount
amt, MixedAmount
bal) =
    forall arg result. Term arg result => arg -> result
L.tr_ (do (forall arg result. Term arg result => arg -> result
L.td_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhichDate -> Query -> Query -> Transaction -> Day
transactionRegisterDate (ReportOpts -> WhichDate
whichDate ReportOpts
ropts) Query
reportq Query
thisacctq) Transaction
t
              (forall arg result. Term arg result => arg -> result
L.td_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Text
tdescription
              (forall arg result. Term arg result => arg -> result
L.td_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Text
otheracctsstr
              -- piggy back on the oneLine display style for now.
              (forall arg result. Term arg result => arg -> result
L.td_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> String
wbUnpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine) MixedAmount
amt
              (forall arg result. Term arg result => arg -> result
L.td_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> String
wbUnpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine) MixedAmount
bal)

-- | Render a register report as plain text suitable for console output.
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsText CliOpts
copts Query
reportq Query
thisacctq AccountTransactionsReport
items = Builder -> Text
TB.toLazyText forall a b. (a -> b) -> a -> b
$
    Builder
title forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n' forall a. Semigroup a => a -> a -> a
<>
    forall a.
Bool
-> CliOpts
-> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> Builder)
-> (a -> MixedAmount)
-> (a -> MixedAmount)
-> [a]
-> Builder
postingsOrTransactionsReportAsText Bool
alignAll CliOpts
copts Int
-> Int
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount),
    [WideBuilder], [WideBuilder])
-> Builder
itemAsText forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> e
itemamt forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> f
itembal AccountTransactionsReport
items
  where
    alignAll :: Bool
alignAll = String -> RawOpts -> Bool
boolopt String
"align-all" forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
copts
    itemAsText :: Int
-> Int
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount),
    [WideBuilder], [WideBuilder])
-> Builder
itemAsText = CliOpts
-> Query
-> Query
-> Int
-> Int
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount),
    [WideBuilder], [WideBuilder])
-> Builder
accountTransactionsReportItemAsText CliOpts
copts Query
reportq Query
thisacctq
    itemamt :: (a, b, c, d, e, f) -> e
itemamt (a
_,b
_,c
_,d
_,e
a,f
_) = e
a
    itembal :: (a, b, c, d, e, f) -> f
itembal (a
_,b
_,c
_,d
_,e
_,f
a) = f
a

    -- show a title indicating which account was picked, which can be confusing otherwise
    title :: Builder
title = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Text
s -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
TB.fromText [Text
"Transactions in ", Text
s, Text
" and subaccounts", Text
qmsg, Text
":"]) Maybe Text
macct
      where
        -- XXX temporary hack ? recover the account name from the query
        macct :: Maybe Text
macct = case (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAcct Query
thisacctq of
                  Acct Regexp
r -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
5 forall a b. (a -> b) -> a -> b
$ Regexp -> Text
reString Regexp
r  -- Acct "^JS:expenses(:|$)"
                  Query
_      -> forall a. Maybe a
Nothing  -- shouldn't happen
        -- show a hint in the title when results are restricted by an extra query (other than depth or date or date2)
        qmsg :: Text
qmsg = if Bool
hasextraquery then Text
" (matching query)" else Text
""
          where
            hasextraquery :: Bool
hasextraquery =
              forall (t :: * -> *) a. Foldable t => t a -> Int
length (ReportOpts -> [Text]
querystring_ forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
copts) forall a. Ord a => a -> a -> Bool
> Int
1
              Bool -> Bool -> Bool
&& Bool -> Bool
not (Query -> Bool
queryIsNull forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.(\Query
q->Query -> Bool
queryIsDepth Query
q Bool -> Bool -> Bool
|| Query -> Bool
queryIsDateOrDate2 Query
q)) Query
reportq)

-- | Render one account register report line item as plain text. Layout is like so:
-- @
-- <---------------- width (specified, terminal width, or 80) -------------------->
-- date (10)  description           other accounts       change (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.
--
-- Returns a string which can be multi-line, eg if the running balance
-- has multiple commodities.
--
accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int
                                    -> (AccountTransactionsReportItem, [WideBuilder], [WideBuilder])
                                    -> TB.Builder
accountTransactionsReportItemAsText :: CliOpts
-> Query
-> Query
-> Int
-> Int
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount),
    [WideBuilder], [WideBuilder])
-> Builder
accountTransactionsReportItemAsText
  copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts}}
  Query
reportq Query
thisacctq Int
preferredamtwidth Int
preferredbalwidth
  ((t :: Transaction
t@Transaction{Text
tdescription :: Text
tdescription :: Transaction -> Text
tdescription}, Transaction
_, Bool
_issplit, Text
otheracctsstr, MixedAmount
_, MixedAmount
_), [WideBuilder]
amt, [WideBuilder]
bal) =
    -- Transaction -- the transaction, unmodified
    -- Transaction -- the transaction, as seen from the current account
    -- Bool        -- is this a split (more than one posting to other accounts) ?
    -- String      -- a display string describing the other account(s), if any
    -- MixedAmount -- the amount posted to the current account(s) (or total amount posted)
    -- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction
    Builder
table forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n'
  where
    table :: Builder
table = TableOpts -> Header Cell -> Builder
renderRowB forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False} forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall h. h -> Header h
Header
      [ Align -> Text -> Cell
textCell Align
TopLeft forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (forall a. a -> Maybe a
Just Int
datewidth) (forall a. a -> Maybe a
Just Int
datewidth) Bool
True Bool
True Text
date
      , Cell
spacerCell
      , Align -> Text -> Cell
textCell Align
TopLeft forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (forall a. a -> Maybe a
Just Int
descwidth) (forall a. a -> Maybe a
Just Int
descwidth) Bool
True Bool
True Text
tdescription
      , Cell
spacerCell2
      , Align -> Text -> Cell
textCell Align
TopLeft forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (forall a. a -> Maybe a
Just Int
acctwidth) (forall a. a -> Maybe a
Just Int
acctwidth) Bool
True Bool
True Text
accts
      , Cell
spacerCell2
      , Align -> [WideBuilder] -> Cell
Cell Align
TopRight forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> WideBuilder -> WideBuilder
pad Int
amtwidth) [WideBuilder]
amt
      , Cell
spacerCell2
      , Align -> [WideBuilder] -> Cell
Cell Align
BottomRight forall a b. (a -> b) -> a -> b
$ 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 (String -> Builder
TB.fromString String
"  ") Int
2]
    pad :: Int -> WideBuilder -> WideBuilder
pad Int
fullwidth WideBuilder
amt1 = Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
w Text
" ") Int
w forall a. Semigroup a => a -> a -> a
<> WideBuilder
amt1
      where w :: Int
w = Int
fullwidth forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
amt1
    -- calculate widths
    (Int
totalwidth,Maybe Int
mdescwidth) = CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts
copts
    (Int
datewidth, Text
date) = (Int
10, Day -> Text
showDate forall a b. (a -> b) -> a -> b
$ WhichDate -> Query -> Query -> Transaction -> Day
transactionRegisterDate WhichDate
wd Query
reportq Query
thisacctq Transaction
t)
      where wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
ropts
    (Int
amtwidth, Int
balwidth)
      | Int
shortfall 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 = forall a. Ord a => a -> a -> a
max Int
0 (Int
totalwidth forall a. Num a => a -> a -> a
- (Int
datewidth forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
mincolwidth forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
mincolwidth forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2))
        shortfall :: Int
shortfall = (Int
preferredamtwidth forall a. Num a => a -> a -> a
+ Int
preferredbalwidth) forall a. Num a => a -> a -> a
- Int
maxamtswidth
        amtwidthproportion :: Double
amtwidthproportion = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
preferredamtwidth forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
preferredamtwidth forall a. Num a => a -> a -> a
+ Int
preferredbalwidth)
        adjustedamtwidth :: Int
adjustedamtwidth = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
amtwidthproportion forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxamtswidth
        adjustedbalwidth :: Int
adjustedbalwidth = Int
maxamtswidth forall a. Num a => a -> a -> a
- Int
adjustedamtwidth

    remaining :: Int
remaining = Int
totalwidth forall a. Num a => a -> a -> a
- (Int
datewidth forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
amtwidth forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
balwidth)
    (Int
descwidth, Int
acctwidth) = (Int
w, Int
remaining forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
- Int
w)
      where w :: Int
w = forall a. a -> Maybe a -> a
fromMaybe ((Int
remaining forall a. Num a => a -> a -> a
- Int
2) forall a. Integral a => a -> a -> a
`div` Int
2) Maybe Int
mdescwidth

    -- gather content
    accts :: Text
accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
            Text
otheracctsstr

-- tests

tests_Aregister :: TestTree
tests_Aregister = String -> [TestTree] -> TestTree
testGroup String
"Aregister" [

 ]