{-|

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 Control.Monad (when)
import Data.Aeson (toJSON)
import Data.Aeson.Text (encodeToLazyText)
import Data.List
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time (addDays)
import Safe (headDef)
import System.Console.CmdArgs.Explicit
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 ["txn-dates"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "txn-dates") 
     "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 ["no-elide"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "no-elide") "don't limit amount commodities shown to 2"
  --  flagNone ["cumulative"] (setboolopt "change")
  --    "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  ["width","w"] (\s :: CommandDoc
s opts :: 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 "width" CommandDoc
s RawOpts
opts) "N"
     ("set output width (default: " CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
#ifdef mingw32_HOST_OS
      show defaultWidth
#else
      "terminal width"
#endif
      CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ " or $COLUMNS). -wN,M sets description width as well."
     )
  ,[CommandDoc] -> Flag RawOpts
outputFormatFlag ["txt","csv","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 "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,reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
  Day
d <- IO Day
getCurrentDay
  -- the first argument specifies the account, any remaining arguments are a filter query
  let args' :: [CommandDoc]
args' = CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt "args" RawOpts
rawopts
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([CommandDoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommandDoc]
args') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDoc -> IO ()
forall a. CommandDoc -> a
error' "aregister needs an account, please provide an account name or pattern"  -- PARTIAL:
  let
    (apat :: CommandDoc
apat:queryargs :: [CommandDoc]
queryargs) = [CommandDoc]
args'
    acct :: Text
acct = Text -> [Text] -> Text
forall a. a -> [a] -> a
headDef (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]
++" did not match any account")   -- PARTIAL:
           ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
filterAccts ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalAccountNames Journal
j
    filterAccts :: [Text] -> [Text]
filterAccts = case CommandDoc -> Either CommandDoc Regexp
toRegexCI CommandDoc
apat of
        Right re :: Regexp
re -> (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Regexp -> CommandDoc -> Bool
regexMatch Regexp
re (CommandDoc -> Bool) -> (Text -> CommandDoc) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CommandDoc
T.unpack)
        Left  _  -> [Text] -> [Text] -> [Text]
forall a b. a -> b -> a
const []
    -- 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' = ReportOpts
ropts{
       query_ :: CommandDoc
query_=[CommandDoc] -> CommandDoc
unwords ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ (CommandDoc -> CommandDoc) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> CommandDoc
quoteIfNeeded ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ [CommandDoc]
queryargs
       -- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX
      ,depth_ :: Maybe Int
depth_=Maybe Int
forall a. Maybe a
Nothing
       -- always show historical balance
      ,balancetype_ :: BalanceType
balancetype_= BalanceType
HistoricalBalance
      }
    reportq :: Query
reportq = [Query] -> Query
And [Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts', 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 True = Query
Any
        excludeforecastq 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 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 ?
    (balancelabel :: CommandDoc
balancelabel,items :: [AccountTransactionsReportItem]
items) = ReportOpts
-> Journal
-> Query
-> Query
-> (CommandDoc, [AccountTransactionsReportItem])
accountTransactionsReport ReportOpts
ropts' Journal
j Query
reportq Query
thisacctq
    items' :: [AccountTransactionsReportItem]
items' = (if ReportOpts -> Bool
empty_ ReportOpts
ropts then [AccountTransactionsReportItem] -> [AccountTransactionsReportItem]
forall a. a -> a
id else (AccountTransactionsReportItem -> Bool)
-> [AccountTransactionsReportItem]
-> [AccountTransactionsReportItem]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (AccountTransactionsReportItem -> Bool)
-> AccountTransactionsReportItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> (AccountTransactionsReportItem -> MixedAmount)
-> AccountTransactionsReportItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountTransactionsReportItem -> MixedAmount
forall a b c d e f. (a, b, c, d, e, f) -> e
fifth6)) ([AccountTransactionsReportItem]
 -> [AccountTransactionsReportItem])
-> [AccountTransactionsReportItem]
-> [AccountTransactionsReportItem]
forall a b. (a -> b) -> a -> b
$
             [AccountTransactionsReportItem] -> [AccountTransactionsReportItem]
forall a. [a] -> [a]
reverse [AccountTransactionsReportItem]
items
    -- select renderer
    render :: (CommandDoc, [AccountTransactionsReportItem]) -> CommandDoc
render | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
=="json" = (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"\n") (CommandDoc -> CommandDoc)
-> ((CommandDoc, [AccountTransactionsReportItem]) -> CommandDoc)
-> (CommandDoc, [AccountTransactionsReportItem])
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CommandDoc
T.unpack (Text -> CommandDoc)
-> ((CommandDoc, [AccountTransactionsReportItem]) -> Text)
-> (CommandDoc, [AccountTransactionsReportItem])
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text)
-> ((CommandDoc, [AccountTransactionsReportItem]) -> Text)
-> (CommandDoc, [AccountTransactionsReportItem])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (Value -> Text)
-> ((CommandDoc, [AccountTransactionsReportItem]) -> Value)
-> (CommandDoc, [AccountTransactionsReportItem])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandDoc, [AccountTransactionsReportItem]) -> Value
forall a. ToJSON a => a -> Value
toJSON
           | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
=="csv"  = (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"\n") (CommandDoc -> CommandDoc)
-> ((CommandDoc, [AccountTransactionsReportItem]) -> CommandDoc)
-> (CommandDoc, [AccountTransactionsReportItem])
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CommandDoc
printCSV (CSV -> CommandDoc)
-> ((CommandDoc, [AccountTransactionsReportItem]) -> CSV)
-> (CommandDoc, [AccountTransactionsReportItem])
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query
-> Query -> (CommandDoc, [AccountTransactionsReportItem]) -> CSV
accountTransactionsReportAsCsv Query
reportq Query
thisacctq
           | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
=="txt"  = CliOpts
-> Query
-> Query
-> (CommandDoc, [AccountTransactionsReportItem])
-> CommandDoc
accountTransactionsReportAsText CliOpts
opts Query
reportq Query
thisacctq
           | Bool
otherwise   = CommandDoc
-> (CommandDoc, [AccountTransactionsReportItem]) -> CommandDoc
forall a b. a -> b -> a
const (CommandDoc
 -> (CommandDoc, [AccountTransactionsReportItem]) -> CommandDoc)
-> CommandDoc
-> (CommandDoc, [AccountTransactionsReportItem])
-> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
forall a. CommandDoc -> a
error' (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt  -- PARTIAL:
      where
        fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts

  CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ (CommandDoc, [AccountTransactionsReportItem]) -> CommandDoc
render (CommandDoc
balancelabel,[AccountTransactionsReportItem]
items')

accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv :: Query
-> Query -> (CommandDoc, [AccountTransactionsReportItem]) -> CSV
accountTransactionsReportAsCsv reportq :: Query
reportq thisacctq :: Query
thisacctq (_,is :: [AccountTransactionsReportItem]
is) =
  ["txnidx","date","code","description","otheraccounts","change","balance"]
  [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
: (AccountTransactionsReportItem -> [CommandDoc])
-> [AccountTransactionsReportItem] -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Query -> AccountTransactionsReportItem -> [CommandDoc]
accountTransactionsReportItemAsCsvRecord Query
reportq Query
thisacctq) [AccountTransactionsReportItem]
is

accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransactionsReportItem -> CsvRecord
accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransactionsReportItem -> [CommandDoc]
accountTransactionsReportItemAsCsvRecord
  reportq :: Query
reportq thisacctq :: 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}, _, _issplit :: Bool
_issplit, otheracctsstr :: CommandDoc
otheracctsstr, change :: MixedAmount
change, balance :: MixedAmount
balance)
  = [CommandDoc
idx,CommandDoc
date,CommandDoc
code,CommandDoc
desc,CommandDoc
otheracctsstr,CommandDoc
amt,CommandDoc
bal]
  where
    idx :: CommandDoc
idx  = Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show Integer
tindex
    date :: CommandDoc
date = Day -> CommandDoc
showDate (Day -> CommandDoc) -> Day -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Query -> Query -> Transaction -> Day
transactionRegisterDate Query
reportq Query
thisacctq Transaction
t
    code :: CommandDoc
code = Text -> CommandDoc
T.unpack Text
tcode
    desc :: CommandDoc
desc = Text -> CommandDoc
T.unpack Text
tdescription
    amt :: CommandDoc
amt  = Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False MixedAmount
change
    bal :: CommandDoc
bal  = Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False MixedAmount
balance

-- | Render a register report as plain text suitable for console output.
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String
accountTransactionsReportAsText :: CliOpts
-> Query
-> Query
-> (CommandDoc, [AccountTransactionsReportItem])
-> CommandDoc
accountTransactionsReportAsText
  copts :: CliOpts
copts@CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts{Bool
no_elide_ :: ReportOpts -> Bool
no_elide_ :: Bool
no_elide_}} reportq :: Query
reportq thisacctq :: Query
thisacctq (_balancelabel :: CommandDoc
_balancelabel,items :: [AccountTransactionsReportItem]
items)
  = [CommandDoc] -> CommandDoc
unlines ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc
title CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
    (AccountTransactionsReportItem -> CommandDoc)
-> [AccountTransactionsReportItem] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (CliOpts
-> Query
-> Query
-> Int
-> Int
-> AccountTransactionsReportItem
-> CommandDoc
accountTransactionsReportItemAsText CliOpts
copts Query
reportq Query
thisacctq Int
amtwidth Int
balwidth) [AccountTransactionsReportItem]
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
$ 12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (AccountTransactionsReportItem -> Int)
-> [AccountTransactionsReportItem] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Int
strWidth (CommandDoc -> Int)
-> (AccountTransactionsReportItem -> CommandDoc)
-> AccountTransactionsReportItem
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> CommandDoc
showamt (MixedAmount -> CommandDoc)
-> (AccountTransactionsReportItem -> MixedAmount)
-> AccountTransactionsReportItem
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountTransactionsReportItem -> MixedAmount
forall a b c d e f. (a, b, c, d, e, f) -> e
itemamt) [AccountTransactionsReportItem]
items
    balwidth :: Int
balwidth = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ 12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (AccountTransactionsReportItem -> Int)
-> [AccountTransactionsReportItem] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Int
strWidth (CommandDoc -> Int)
-> (AccountTransactionsReportItem -> CommandDoc)
-> AccountTransactionsReportItem
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> CommandDoc
showamt (MixedAmount -> CommandDoc)
-> (AccountTransactionsReportItem -> MixedAmount)
-> AccountTransactionsReportItem
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountTransactionsReportItem -> MixedAmount
forall a b c d e f. (a, b, c, d, e, f) -> f
itembal) [AccountTransactionsReportItem]
items
    showamt :: MixedAmount -> CommandDoc
showamt
      | Bool
no_elide_ = Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False -- color_
      | Bool
otherwise = Bool -> MixedAmount -> CommandDoc
showMixedAmountElided Bool
False
    itemamt :: (a, b, c, d, e, f) -> e
itemamt (_,_,_,_,a :: e
a,_) = e
a
    itembal :: (a, b, c, d, e, f) -> f
itembal (_,_,_,_,_,a :: f
a) = f
a
    -- show a title indicating which account was picked, which can be confusing otherwise
    title :: CommandDoc
title = Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (("Transactions in "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>" 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 r :: Regexp
r -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (CommandDoc -> Text) -> CommandDoc -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop 1 (Text -> Text) -> (CommandDoc -> Text) -> CommandDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd 5 (Text -> Text) -> (CommandDoc -> Text) -> CommandDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> Text
T.pack (CommandDoc -> Maybe Text) -> CommandDoc -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Regexp -> CommandDoc
reString Regexp
r  -- Acct "^JS:expenses(:|$)"
                  _      -> 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 -> String
accountTransactionsReportItemAsText :: CliOpts
-> Query
-> Query
-> Int
-> Int
-> AccountTransactionsReportItem
-> CommandDoc
accountTransactionsReportItemAsText
  copts :: CliOpts
copts@CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts{Bool
color_ :: ReportOpts -> Bool
color_ :: Bool
color_,Bool
no_elide_ :: Bool
no_elide_ :: ReportOpts -> Bool
no_elide_}}
  reportq :: Query
reportq thisacctq :: Query
thisacctq preferredamtwidth :: Int
preferredamtwidth preferredbalwidth :: Int
preferredbalwidth
  (t :: Transaction
t@Transaction{Text
tdescription :: Text
tdescription :: Transaction -> Text
tdescription}, _, _issplit :: Bool
_issplit, otheracctsstr :: CommandDoc
otheracctsstr, change :: MixedAmount
change, balance :: 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

  = CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$
    [CommandDoc] -> CommandDoc
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (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 CommandDoc
date
           ," "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (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 CommandDoc
desc
           ,"  "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (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 CommandDoc
accts
           ,"  "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) Bool
True Bool
False CommandDoc
amtfirstline
           ,"  "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) Bool
True Bool
False CommandDoc
balfirstline
           ]
    CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
    [[CommandDoc] -> CommandDoc
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [CommandDoc
spacer
            ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) Bool
True Bool
False CommandDoc
a
            ,"  "
            ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) Bool
True Bool
False CommandDoc
b
            ]
     | (a :: CommandDoc
a,b :: CommandDoc
b) <- [CommandDoc] -> [CommandDoc] -> [(CommandDoc, CommandDoc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CommandDoc]
amtrest [CommandDoc]
balrest
     ]
    where
      -- calculate widths
      (totalwidth :: Int
totalwidth,mdescwidth :: Maybe Int
mdescwidth) = CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts
copts
      (datewidth :: Int
datewidth, date :: CommandDoc
date) = (10, Day -> CommandDoc
showDate (Day -> CommandDoc) -> Day -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Query -> Query -> Transaction -> Day
transactionRegisterDate Query
reportq Query
thisacctq Transaction
t)
      (amtwidth :: Int
amtwidth, balwidth :: Int
balwidth)
        | Int
shortfall Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = (Int
preferredamtwidth, Int
preferredbalwidth)
        | Bool
otherwise      = (Int
adjustedamtwidth, Int
adjustedbalwidth)
        where
          mincolwidth :: Int
mincolwidth = 2 -- columns always show at least an ellipsis
          maxamtswidth :: Int
maxamtswidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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
+ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mincolwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mincolwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
+ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
balwidth)
      (descwidth :: Int
descwidth, acctwidth :: Int
acctwidth) = (Int
w, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
- 2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) Maybe Int
mdescwidth

      -- gather content
      desc :: CommandDoc
desc = Text -> CommandDoc
T.unpack Text
tdescription
      accts :: CommandDoc
accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
              CommandDoc
otheracctsstr
      showamt :: MixedAmount -> CommandDoc
showamt
        | Bool
no_elide_ = Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
color_
        | Bool
otherwise = Bool -> MixedAmount -> CommandDoc
showMixedAmountElided Bool
color_
      amt :: CommandDoc
amt = MixedAmount -> CommandDoc
showamt MixedAmount
change
      bal :: CommandDoc
bal = MixedAmount -> CommandDoc
showamt MixedAmount
balance
      -- 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'
      (amtlines :: [CommandDoc]
amtlines, ballines :: [CommandDoc]
ballines) = (CommandDoc -> [CommandDoc]
lines CommandDoc
amt, CommandDoc -> [CommandDoc]
lines CommandDoc
bal)
      (amtlen :: Int
amtlen, ballen :: Int
ballen) = ([CommandDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommandDoc]
amtlines, [CommandDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommandDoc]
ballines)
      numlines :: Int
numlines = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
amtlen Int
ballen)
      (amtfirstline :: CommandDoc
amtfirstline:amtrest :: [CommandDoc]
amtrest) = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
take Int
numlines ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ [CommandDoc]
amtlines [CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ CommandDoc -> [CommandDoc]
forall a. a -> [a]
repeat "" -- posting amount is top-aligned
      (balfirstline :: CommandDoc
balfirstline:balrest :: [CommandDoc]
balrest) = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
take Int
numlines ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ Int -> CommandDoc -> [CommandDoc]
forall a. Int -> a -> [a]
replicate (Int
numlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ballen) "" [CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ [CommandDoc]
ballines -- balance amount is bottom-aligned
      spacer :: CommandDoc
spacer = Int -> Char -> CommandDoc
forall a. Int -> a -> [a]
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
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
balwidth)) ' '

-- tests

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

 ]