{-|

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 Data.Text (Text)
import Data.Foldable (for_)
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Control.Monad (when)
import qualified Lucid as L hiding (Html)
import System.Console.CmdArgs.Explicit (flagNone, flagReq)
import qualified System.IO as IO
import Text.Tabular.AsciiWide hiding (render)

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Html (formatRow, htmlAsLazyText, toHtml)
import Hledger.Write.Ods (printFods)
import qualified Hledger.Write.Spreadsheet as Spr

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")
  ([
   [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
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."
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
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"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"cumulative"] (String -> RawOpts -> RawOpts
setboolopt String
"cumulative")
     String
"show running total from report start date"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"historical",String
"H"] (String -> RawOpts -> RawOpts
setboolopt String
"historical")
     String
"show historical running total/balance (includes postings before report start date) (default)"
  -- ,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"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"invert"] (String -> RawOpts -> RawOpts
setboolopt String
"invert") String
"display all amounts with reversed sign"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"heading"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"heading" String
s RawOpts
opts) String
"YN"
     String
"show heading row above table: yes (default) or no"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"width",String
"w"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
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: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
#ifdef mingw32_HOST_OS
      show defaultWidth
#else
      String
"terminal width"
#endif
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"). -wN,M sets description width as well."
     )
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
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
"tsv",String
"json"]
  ,Flag RawOpts
outputFileFlag
  ])
  [(String, [Flag RawOpts])]
cligeneralflagsgroups1
  [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
$ 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
      []     -> String -> IO (String, [Text])
forall a. String -> a
error' (String -> IO (String, [Text])) -> String -> IO (String, [Text])
forall a b. (a -> b) -> a -> b
$ String
help String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".\nPlease provide an account name or a (case-insensitive, infix, regexp) pattern."
      (String
a:[String]
as) -> (String, [Text]) -> IO (String, [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
a, (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
as)
  let
    -- keep synced with accounts --find
    acct :: Text
acct = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. String -> a
error' (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
help String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
",\nbut " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
apatString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" did not match any account.")   -- PARTIAL:
           (Maybe Text -> Text) -> ([Text] -> Maybe Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
firstMatch ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalAccountNamesDeclaredOrImplied Journal
j
    firstMatch :: [Text] -> Maybe Text
firstMatch = case Text -> Either String Regexp
toRegexCI (Text -> Either String Regexp) -> Text -> Either String Regexp
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
apat of
        Right Regexp
re -> (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Regexp -> Text -> Bool
regexMatchText Regexp
re)
        Left  String
_  -> Maybe Text -> [Text] -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing
    -- gather report options
    inclusive :: Bool
inclusive = Bool
True  -- tree_ ropts
    thisacctq :: Query
thisacctq = Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
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_=DepthSpec Nothing []
      , balanceaccum_ =
          case balanceaccum_ $ _rsReportOpts rspec of
            BalanceAccumulation
PerPeriod -> BalanceAccumulation
Historical
            BalanceAccumulation
ba -> BalanceAccumulation
ba
      , querystring_ = querystr
      }
    wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
ropts'
  -- and regenerate the ReportSpec, making sure to use the above
  ReportSpec
rspec' <- (String -> IO ReportSpec)
-> (ReportSpec -> IO ReportSpec)
-> Either String ReportSpec
-> IO ReportSpec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO ReportSpec
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ReportSpec -> IO ReportSpec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ReportSpec -> IO ReportSpec)
-> Either String ReportSpec -> IO ReportSpec
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' =
      Map Text AmountStyle
-> AccountTransactionsReport -> AccountTransactionsReport
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts (Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j) (AccountTransactionsReport -> AccountTransactionsReport)
-> AccountTransactionsReport -> AccountTransactionsReport
forall a b. (a -> b) -> a -> b
$
      (if ReportOpts -> Bool
empty_ ReportOpts
ropts' then AccountTransactionsReport -> AccountTransactionsReport
forall a. a -> a
id else ((Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
 -> Bool)
-> AccountTransactionsReport -> AccountTransactionsReport
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> Bool)
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> MixedAmount)
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> MixedAmount
forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> e
fifth6)) (AccountTransactionsReport -> AccountTransactionsReport)
-> AccountTransactionsReport -> AccountTransactionsReport
forall a b. (a -> b) -> a -> b
$
      AccountTransactionsReport -> AccountTransactionsReport
forall a. [a] -> [a]
reverse AccountTransactionsReport
items
    -- select renderer
    render :: AccountTransactionsReport -> Text
render | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"txt"  = CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsText CliOpts
opts (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"html" = CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsHTML CliOpts
opts (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"csv"  = CSV -> Text
printCSV (CSV -> Text)
-> (AccountTransactionsReport -> CSV)
-> AccountTransactionsReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv Bool
hd WhichDate
wd (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"tsv"  = CSV -> Text
printTSV (CSV -> Text)
-> (AccountTransactionsReport -> CSV)
-> AccountTransactionsReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv Bool
hd WhichDate
wd (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"fods" =
                TextEncoding
-> Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text
printFods TextEncoding
IO.localeEncoding (Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text)
-> (AccountTransactionsReport
    -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> AccountTransactionsReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ((Int, Int), [[Cell NumLines Text]])
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall k a. k -> a -> Map k a
Map.singleton Text
"Aregister" (((Int, Int), [[Cell NumLines Text]])
 -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> (AccountTransactionsReport
    -> ((Int, Int), [[Cell NumLines Text]]))
-> AccountTransactionsReport
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (,) (Int
1,Int
0) ([[Cell NumLines Text]] -> ((Int, Int), [[Cell NumLines Text]]))
-> (AccountTransactionsReport -> [[Cell NumLines Text]])
-> AccountTransactionsReport
-> ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                AmountFormat
-> Bool
-> WhichDate
-> Query
-> Query
-> AccountTransactionsReport
-> [[Cell NumLines Text]]
accountTransactionsReportAsSpreadsheet AmountFormat
oneLineNoCostFmt Bool
hd WhichDate
wd (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"json" = AccountTransactionsReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
           | Bool
otherwise   = String -> AccountTransactionsReport -> Text
forall a. String -> a
error' (String -> AccountTransactionsReport -> Text)
-> String -> AccountTransactionsReport -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
unsupportedOutputFormatError String
fmt  -- PARTIAL:
      where
        hd :: Bool
hd = CliOpts -> Bool
headingopt CliOpts
opts
        fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts

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

accountTransactionsReportAsCsv ::
  Bool -> WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv :: Bool
-> WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv Bool
hd WhichDate
wd Query
reportq Query
thisacctq =
  [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
Spr.rawTableContent ([[Cell NumLines Text]] -> CSV)
-> (AccountTransactionsReport -> [[Cell NumLines Text]])
-> AccountTransactionsReport
-> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  AmountFormat
-> Bool
-> WhichDate
-> Query
-> Query
-> AccountTransactionsReport
-> [[Cell NumLines Text]]
accountTransactionsReportAsSpreadsheet AmountFormat
machineFmt Bool
hd WhichDate
wd Query
reportq Query
thisacctq

accountTransactionsReportAsSpreadsheet ::
  AmountFormat -> Bool ->
  WhichDate -> Query -> Query -> AccountTransactionsReport ->
  [[Spr.Cell Spr.NumLines Text]]
accountTransactionsReportAsSpreadsheet :: AmountFormat
-> Bool
-> WhichDate
-> Query
-> Query
-> AccountTransactionsReport
-> [[Cell NumLines Text]]
accountTransactionsReportAsSpreadsheet AmountFormat
fmt Bool
hd WhichDate
wd Query
reportq Query
thisacctq AccountTransactionsReport
is =
  Bool -> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall p. Monoid p => Bool -> p -> p
optional Bool
hd
    [[Cell () Text] -> [Cell NumLines Text]
forall text. [Cell () text] -> [Cell NumLines text]
Spr.addHeaderBorders ([Cell () Text] -> [Cell NumLines Text])
-> [Cell () Text] -> [Cell NumLines Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Cell () Text) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell ([Text] -> [Cell () Text]) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> a -> b
$
      [Text
"txnidx",Text
"date",Text
"code",Text
"description",Text
"otheraccounts",Text
"change",Text
"balance"]]
  [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++
  ((Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
 -> [Cell NumLines Text])
-> AccountTransactionsReport -> [[Cell NumLines Text]]
forall a b. (a -> b) -> [a] -> [b]
map (AmountFormat
-> Bool
-> WhichDate
-> Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Cell NumLines Text]
accountTransactionsReportItemAsRecord AmountFormat
fmt Bool
True WhichDate
wd Query
reportq Query
thisacctq) AccountTransactionsReport
is

accountTransactionsReportItemAsRecord ::
  AmountFormat -> Bool ->
  WhichDate -> Query -> Query -> AccountTransactionsReportItem ->
  [Spr.Cell Spr.NumLines Text]
accountTransactionsReportItemAsRecord :: AmountFormat
-> Bool
-> WhichDate
-> Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Cell NumLines Text]
accountTransactionsReportItemAsRecord
  AmountFormat
fmt Bool
internals WhichDate
wd Query
reportq Query
thisacctq
  (t :: Transaction
t@Transaction{Integer
tindex :: Integer
tindex :: Transaction -> Integer
tindex,Text
tcode :: Text
tcode :: Transaction -> Text
tcode,Text
tdescription :: Text
tdescription :: Transaction -> Text
tdescription}, Transaction
_, Bool
_issplit, Text
otheracctsstr, MixedAmount
change, MixedAmount
balance)
  = (Bool -> [Cell NumLines Text] -> [Cell NumLines Text]
forall p. Monoid p => Bool -> p -> p
optional Bool
internals [Integer -> Cell NumLines Text
forall border. Lines border => Integer -> Cell border Text
Spr.integerCell Integer
tindex]) [Cell NumLines Text]
-> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. [a] -> [a] -> [a]
++
    Cell NumLines Text
date Cell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:
    (Bool -> [Cell NumLines Text] -> [Cell NumLines Text]
forall p. Monoid p => Bool -> p -> p
optional Bool
internals [Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell Text
tcode]) [Cell NumLines Text]
-> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. [a] -> [a] -> [a]
++
    [Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell Text
tdescription,
     Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell Text
otheracctsstr,
     MixedAmount -> Cell NumLines Text
forall {border}. Lines border => MixedAmount -> Cell border Text
amountCell MixedAmount
change,
     MixedAmount -> Cell NumLines Text
forall {border}. Lines border => MixedAmount -> Cell border Text
amountCell MixedAmount
balance]
  where
    cell :: text -> Cell NumLines text
cell = text -> Cell NumLines text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell
    date :: Cell NumLines Text
date =
        (Text -> Cell NumLines Text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Day -> Text
showDate (Day -> Text) -> Day -> Text
forall a b. (a -> b) -> a -> b
$
         WhichDate -> Query -> Query -> Transaction -> Day
transactionRegisterDate WhichDate
wd Query
reportq Query
thisacctq Transaction
t)
            {Spr.cellType = Spr.TypeDate}
    amountCell :: MixedAmount -> Cell border Text
amountCell MixedAmount
amt =
      WideBuilder -> Text
wbToText (WideBuilder -> Text)
-> Cell border WideBuilder -> Cell border Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AmountFormat -> (Class, MixedAmount) -> Cell border WideBuilder
forall border.
Lines border =>
AmountFormat -> (Class, MixedAmount) -> Cell border WideBuilder
Spr.cellFromMixedAmount AmountFormat
fmt (Text -> Class
Spr.Class Text
"amount", MixedAmount
amt)

-- | 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 =
  HtmlT Identity () -> Text
htmlAsLazyText (HtmlT Identity () -> Text) -> HtmlT Identity () -> Text
forall a b. (a -> b) -> a -> b
$ do
    [Attribute] -> HtmlT Identity ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
L.link_ [Text -> Attribute
L.rel_ Text
"stylesheet", Text -> Attribute
L.href_ Text
"hledger.css"]
    HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.table_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> HtmlT Identity () -> HtmlT Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CliOpts -> Bool
headingopt CliOpts
copts) (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.thead_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.tr_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"date"
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"description"
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"otheraccounts"
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"change"
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.th_ HtmlT Identity ()
"balance"
      HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
L.tbody_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ AccountTransactionsReport
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> HtmlT Identity ())
-> HtmlT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ AccountTransactionsReport
items (((Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
  -> HtmlT Identity ())
 -> HtmlT Identity ())
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> HtmlT Identity ())
-> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$
        [Cell NumLines (HtmlT Identity ())] -> HtmlT Identity ()
forall border.
Lines border =>
[Cell border (HtmlT Identity ())] -> HtmlT Identity ()
formatRow ([Cell NumLines (HtmlT Identity ())] -> HtmlT Identity ())
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> [Cell NumLines (HtmlT Identity ())])
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell NumLines Text -> Cell NumLines (HtmlT Identity ()))
-> [Cell NumLines Text] -> [Cell NumLines (HtmlT Identity ())]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> HtmlT Identity ())
-> Cell NumLines Text -> Cell NumLines (HtmlT Identity ())
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml) ([Cell NumLines Text] -> [Cell NumLines (HtmlT Identity ())])
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> [Cell NumLines Text])
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Cell NumLines (HtmlT Identity ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        AmountFormat
-> Bool
-> WhichDate
-> Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Cell NumLines Text]
accountTransactionsReportItemAsRecord
          AmountFormat
oneLineNoCostFmt Bool
False
          (ReportOpts -> WhichDate
whichDate (ReportOpts -> WhichDate) -> ReportOpts -> WhichDate
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> ReportOpts) -> ReportSpec -> ReportOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
copts)
          Query
reportq Query
thisacctq

-- | 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 (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
    (Bool -> Builder -> Builder
forall p. Monoid p => Bool -> p -> p
optional (CliOpts -> Bool
headingopt CliOpts
copts) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
title Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n')
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Bool
-> CliOpts
-> (Int
    -> Int
    -> ((Transaction, Transaction, Bool, Text, MixedAmount,
         MixedAmount),
        [WideBuilder], [WideBuilder])
    -> Builder)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> MixedAmount)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> MixedAmount)
-> AccountTransactionsReport
-> Builder
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 (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> MixedAmount
forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> e
itemamt (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> MixedAmount
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" (RawOpts -> Bool) -> RawOpts -> Bool
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 = Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (\Text
s -> (Text -> Builder) -> [Text] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
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 -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
5 (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Regexp -> Text
reString Regexp
r  -- Acct "^JS:expenses(:|$)"
                  Query
_      -> Maybe Text
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 =
              [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ReportOpts -> [Text]
querystring_ (ReportOpts -> [Text]) -> ReportOpts -> [Text]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> ReportOpts) -> ReportSpec -> ReportOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
copts) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
              Bool -> Bool -> Bool
&& Bool -> Bool
not (Query -> Bool
queryIsNull (Query -> Bool) -> Query -> Bool
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not(Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall 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)

headingopt :: CliOpts -> Bool
headingopt :: CliOpts -> Bool
headingopt = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> (CliOpts -> Maybe Bool) -> CliOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawOpts -> Maybe Bool
maybeynopt String
"heading" (RawOpts -> Maybe Bool)
-> (CliOpts -> RawOpts) -> CliOpts -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> RawOpts
rawopts_

optional :: (Monoid p) => Bool -> p -> p
optional :: forall p. Monoid p => Bool -> p -> p
optional Bool
b p
x = if Bool
b then p
x else p
forall a. Monoid a => a
mempty


-- | 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 :: Transaction -> Text
tdescription :: 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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n'
  where
    table :: Builder
table = TableOpts -> Header Cell -> Builder
renderRowB TableOpts
forall a. Default a => a
def{tableBorders=False, borderSpaces=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 -> Text -> Cell
textCell Align
TopLeft (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
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 Text
date
      , Cell
spacerCell
      , Align -> Text -> Cell
textCell Align
TopLeft (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
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 Text
tdescription
      , Cell
spacerCell2
      , Align -> Text -> Cell
textCell Align
TopLeft (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
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 Text
accts
      , 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 (String -> Builder
TB.fromString String
"  ") Int
2]
    pad :: Int -> WideBuilder -> WideBuilder
pad Int
fullwidth WideBuilder
amt1 = Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
w Text
" ") Int
w WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
amt1
      where w :: Int
w = Int
fullwidth Int -> Int -> Int
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 (Day -> Text) -> Day -> Text
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 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 b. Integral b => Double -> b
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) = (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 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
    accts :: Text
accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
            Text
otheracctsstr

-- tests

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

 ]