{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Aregister (
aregistermode
,aregister
,tests_Aregister
) where
import Data.List (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 Safe (headDef)
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"
,[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]")
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
(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 -> [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]
++CommandDoc
" did not match any account")
([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 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] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Regexp -> Text -> Bool
regexMatchText Regexp
re)
Left CommandDoc
_ -> [Text] -> [Text] -> [Text]
forall a b. a -> b -> a
const []
inclusive :: Bool
inclusive = Bool
True
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) {
depth_ :: Maybe Int
depth_=Maybe Int
forall a. Maybe a
Nothing
, balancetype_ :: BalanceType
balancetype_= BalanceType
HistoricalBalance
}
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
excludeforecastq :: Bool -> Query
excludeforecastq Bool
True = Query
Any
excludeforecastq Bool
False =
[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
]
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
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
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
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}
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
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
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
Query
_ -> Maybe Text
forall a. Maybe a
Nothing
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) =
(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
(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
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
accts :: Text
accts =
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}
([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
""
(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
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_Aregister :: TestTree
tests_Aregister = CommandDoc -> [TestTree] -> TestTree
tests CommandDoc
"Aregister" [
]