{-|

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.List (find, intersperse)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time (addDays)
import System.Console.CmdArgs.Explicit (flagNone, flagReq)
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)

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

aregistermode :: Mode RawOpts
aregistermode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Aregister.txt")
  ([
   [CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"txn-dates"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"txn-dates") 
     CommandDoc
"filter strictly by transaction date, not posting date. Warning: this can show a wrong running balance."
   ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"no-elide"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"no-elide") CommandDoc
"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"
  ,[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
"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
  Day
d <- IO Day
getCurrentDay
  -- the first argument specifies the account, any remaining arguments are a filter query
  (CommandDoc
apat,[Text]
querystring) <- case CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"args" RawOpts
rawopts of
      []     -> CommandDoc -> IO (CommandDoc, [Text])
forall (m :: * -> *) a. MonadFail m => CommandDoc -> m a
fail CommandDoc
"aregister needs an account, please provide an account name or pattern"
      (CommandDoc
a:[CommandDoc]
as) -> (CommandDoc, [Text]) -> IO (CommandDoc, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandDoc
a, (CommandDoc -> Text) -> [CommandDoc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> Text
T.pack [CommandDoc]
as)
  Query
argsquery <- (CommandDoc -> IO Query)
-> ((Query, [QueryOpt]) -> IO Query)
-> Either CommandDoc (Query, [QueryOpt])
-> IO Query
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CommandDoc -> IO Query
forall (m :: * -> *) a. MonadFail m => CommandDoc -> m a
fail (Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> IO Query)
-> ((Query, [QueryOpt]) -> Query)
-> (Query, [QueryOpt])
-> IO Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst) (Either CommandDoc (Query, [QueryOpt]) -> IO Query)
-> Either CommandDoc (Query, [QueryOpt]) -> IO Query
forall a b. (a -> b) -> a -> b
$ Day -> [Text] -> Either CommandDoc (Query, [QueryOpt])
parseQueryList Day
d [Text]
querystring
  let
    acct :: Text
acct = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (CommandDoc -> Text
forall a. CommandDoc -> a
error' (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
forall a. Show a => a -> CommandDoc
show CommandDoc
apatCommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
" 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 CommandDoc Regexp
toRegexCI (Text -> Either CommandDoc Regexp)
-> Text -> Either CommandDoc Regexp
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Text
T.pack CommandDoc
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  CommandDoc
_  -> 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
rsOpts ReportSpec
rspec) {
        -- ignore any depth limit, as in postingsReport; allows register's total to match balance reports (cf #1468)
        depth_ :: Maybe Int
depth_=Maybe Int
forall a. Maybe a
Nothing
        -- always show historical balance
      , balancetype_ :: BalanceType
balancetype_= BalanceType
HistoricalBalance
      }
    -- and regenerate the ReportSpec, making sure to use the above
    rspec' :: ReportSpec
rspec' = ReportSpec
rspec{ rsQuery :: Query
rsQuery=Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportOpts -> Query
queryFromFlags ReportOpts
ropts', Query
argsquery]
                  , rsOpts :: ReportOpts
rsOpts=ReportOpts
ropts'
                  }
    reportq :: Query
reportq = [Query] -> Query
And [ReportSpec -> Query
rsQuery ReportSpec
rspec', Bool -> Query
excludeforecastq (Maybe DateSpan -> Bool
forall a. Maybe a -> Bool
isJust (Maybe DateSpan -> Bool) -> Maybe DateSpan -> Bool
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Maybe DateSpan
forecast_ ReportOpts
ropts')]
      where
        -- As in RegisterScreen, why ? XXX
        -- Except in forecast mode, exclude future/forecast transactions.
        excludeforecastq :: Bool -> Query
excludeforecastq Bool
True = Query
Any
        excludeforecastq Bool
False =  -- not:date:tomorrow- not:tag:generated-transaction
          [Query] -> Query
And [
             Query -> Query
Not (DateSpan -> Query
Date (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
1 Day
d) Maybe Day
forall a. Maybe a
Nothing)
            ,Query -> Query
Not Query
generatedTransactionTag
          ]
    -- 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 -> Query -> AccountTransactionsReport
accountTransactionsReport ReportSpec
rspec' Journal
j Query
reportq Query
thisacctq
    items' :: AccountTransactionsReport
items' = (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 | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"txt"  = CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsText CliOpts
opts Query
reportq Query
thisacctq
           | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"csv"  = CSV -> Text
printCSV (CSV -> Text)
-> (AccountTransactionsReport -> CSV)
-> AccountTransactionsReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv Query
reportq Query
thisacctq
           | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"json" = AccountTransactionsReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
           | Bool
otherwise   = CommandDoc -> AccountTransactionsReport -> Text
forall a. CommandDoc -> a
error' (CommandDoc -> AccountTransactionsReport -> Text)
-> CommandDoc -> AccountTransactionsReport -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt  -- PARTIAL:
      where
        fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
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 :: Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv Query
reportq Query
thisacctq AccountTransactionsReport
is =
  [Text
"txnidx",Text
"date",Text
"code",Text
"description",Text
"otheraccounts",Text
"change",Text
"balance"]
  [Text] -> CSV -> CSV
forall a. a -> [a] -> [a]
: ((Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
 -> [Text])
-> AccountTransactionsReport -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Text]
accountTransactionsReportItemAsCsvRecord Query
reportq Query
thisacctq) AccountTransactionsReport
is

accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransactionsReportItem -> CsvRecord
accountTransactionsReportItemAsCsvRecord :: Query
-> Query
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> [Text]
accountTransactionsReportItemAsCsvRecord
  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  = CommandDoc -> Text
T.pack (CommandDoc -> Text) -> CommandDoc -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show Integer
tindex
    date :: Text
date = Day -> Text
showDate (Day -> Text) -> Day -> Text
forall a b. (a -> b) -> a -> b
$ Query -> Query -> Transaction -> Day
transactionRegisterDate Query
reportq Query
thisacctq Transaction
t
    amt :: Text
amt  = WideBuilder -> Text
wbToText (WideBuilder -> Text) -> WideBuilder -> Text
forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine MixedAmount
change
    bal :: Text
bal  = WideBuilder -> Text
wbToText (WideBuilder -> Text) -> WideBuilder -> Text
forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine MixedAmount
balance

-- | 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] -> 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
$
    Builder
title Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:
    ((Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
 -> Builder)
-> AccountTransactionsReport -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (CliOpts
-> Query
-> Query
-> Int
-> Int
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> Builder
accountTransactionsReportItemAsText CliOpts
copts Query
reportq Query
thisacctq Int
amtwidth Int
balwidth) AccountTransactionsReport
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
$ Int
12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
 -> Int)
-> AccountTransactionsReport -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> WideBuilder)
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> WideBuilder
showamt (MixedAmount -> WideBuilder)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> MixedAmount)
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> WideBuilder
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
itemamt) AccountTransactionsReport
items
    balwidth :: Int
balwidth = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
 -> Int)
-> AccountTransactionsReport -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> WideBuilder)
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> WideBuilder
showamt (MixedAmount -> WideBuilder)
-> ((Transaction, Transaction, Bool, Text, MixedAmount,
     MixedAmount)
    -> MixedAmount)
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> WideBuilder
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) -> f
itembal) AccountTransactionsReport
items
    showamt :: MixedAmount -> WideBuilder
showamt = AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine{displayMinWidth :: Maybe Int
displayMinWidth=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
12, displayMaxWidth :: Maybe Int
displayMaxWidth=Maybe Int
mmax}  -- color_
      where mmax :: Maybe Int
mmax = if ReportOpts -> Bool
no_elide_ (ReportOpts -> Bool) -> (CliOpts -> ReportOpts) -> CliOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
rsOpts (ReportSpec -> ReportOpts)
-> (CliOpts -> ReportSpec) -> CliOpts -> ReportOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> ReportSpec
reportspec_ (CliOpts -> Bool) -> CliOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts
copts then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
32
    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 (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:"]) 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

-- | 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 -> TB.Builder
accountTransactionsReportItemAsText :: CliOpts
-> Query
-> Query
-> Int
-> Int
-> (Transaction, Transaction, Bool, Text, MixedAmount, MixedAmount)
-> Builder
accountTransactionsReportItemAsText
  copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec{rsOpts :: ReportSpec -> ReportOpts
rsOpts=ReportOpts{Bool
color_ :: ReportOpts -> Bool
color_ :: Bool
color_}}}
  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
change, MixedAmount
balance) =
    -- 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
    (Text -> Builder) -> [Text] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Builder
TB.fromText ([Text] -> Builder) -> (CSV -> [Text]) -> CSV -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (CSV -> [Text]) -> (CSV -> CSV) -> CSV -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> CSV -> CSV
forall a. a -> [a] -> [a]
intersperse ([Text
"\n"]) (CSV -> Builder) -> CSV -> Builder
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
      , Text
" "
      , 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
      , Text
"  "
      , 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
      , Text
"  "
      , Text
amtfirstline
      , Text
"  "
      , Text
balfirstline
      ]
      [Text] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
      [ [ Text
spacer, Text
a, Text
"  ", Text
b ] | (Text
a,Text
b) <- [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
amtrest [Text]
balrest ]
  where
    -- 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
$ Query -> Query -> Transaction -> Day
transactionRegisterDate Query
reportq Query
thisacctq Transaction
t)
    (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) = (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
    amt :: Text
amt = Text -> Text
TL.toStrict (Text -> Text) -> (WideBuilder -> Text) -> WideBuilder -> Text
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 -> Text) -> WideBuilder -> Text
forall a b. (a -> b) -> a -> b
$ Int -> MixedAmount -> WideBuilder
showamt Int
amtwidth MixedAmount
change
    bal :: Text
bal = Text -> Text
TL.toStrict (Text -> Text) -> (WideBuilder -> Text) -> WideBuilder -> Text
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 -> Text) -> WideBuilder -> Text
forall a b. (a -> b) -> a -> b
$ Int -> MixedAmount -> WideBuilder
showamt Int
balwidth MixedAmount
balance
    showamt :: Int -> MixedAmount -> WideBuilder
showamt Int
w = AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noPrice{displayColour :: Bool
displayColour=Bool
color_, 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'
    ([Text]
amtlines, [Text]
ballines) = (Text -> [Text]
T.lines Text
amt, Text -> [Text]
T.lines Text
bal)
    (Int
amtlen, Int
ballen) = ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
amtlines, [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
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)
    (Text
amtfirstline:[Text]
amtrest) = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
numlines ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
amtlines [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text]
forall a. a -> [a]
repeat Text
"" -- posting amount is top-aligned
    (Text
balfirstline:[Text]
balrest) = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
numlines ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate (Int
numlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ballen) Text
"" [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ballines -- balance amount is bottom-aligned
    spacer :: Text
spacer = Int -> Text -> Text
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)) Text
" "

-- tests

tests_Aregister :: TestTree
tests_Aregister = CommandDoc -> [TestTree] -> TestTree
tests CommandDoc
"Aregister" [

 ]