{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Aregister (
aregistermode
,aregister
,tests_Aregister
) where
import Data.Default (def)
import Data.List (find)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import System.Console.CmdArgs.Explicit (flagNone, flagReq)
import Hledger
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Text.Tabular.AsciiWide hiding (render)
aregistermode :: Mode RawOpts
aregistermode = String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Aregister.txt")
([
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"txn-dates"] (String -> RawOpts -> RawOpts
setboolopt String
"txn-dates")
String
"filter strictly by transaction date, not posting date. Warning: this can show a wrong running balance."
,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"no-elide"] (String -> RawOpts -> RawOpts
setboolopt String
"no-elide") String
"don't show only 2 commodities per amount"
,forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"width",String
"w"] (\String
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"width" String
s RawOpts
opts) String
"N"
(String
"set output width (default: " forall a. [a] -> [a] -> [a]
++
#ifdef mingw32_HOST_OS
show defaultWidth
#else
String
"terminal width"
#endif
forall a. [a] -> [a] -> [a]
++ String
" or $COLUMNS). -wN,M sets description width as well."
)
,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"align-all"] (String -> RawOpts -> RawOpts
setboolopt String
"align-all") String
"guarantee alignment across all lines (slower)"
,[String] -> Flag RawOpts
outputFormatFlag [String
"txt",String
"csv",String
"json"]
,Flag RawOpts
outputFileFlag
])
[(String, [Flag RawOpts])
generalflagsgroup1]
[Flag RawOpts]
hiddenflags
([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Arg RawOpts
argsFlag String
"ACCTPAT [QUERY]")
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
let help :: String
help = String
"aregister needs an ACCTPAT argument to select an account"
(String
apat,[CsvValue]
querystr) <- case String -> RawOpts -> [String]
listofstringopt String
"args" RawOpts
rawopts of
[] -> forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
help forall a. Semigroup a => a -> a -> a
<> String
".\nPlease provide an account name or a (case-insensitive, infix, regexp) pattern."
(String
a:[String]
as) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
a, forall a b. (a -> b) -> [a] -> [b]
map String -> CsvValue
T.pack [String]
as)
let
acct :: CsvValue
acct = forall a. a -> Maybe a -> a
fromMaybe (forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
help forall a. Semigroup a => a -> a -> a
<> String
",\nbut " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
apatforall a. [a] -> [a] -> [a]
++String
" did not match any account.")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CsvValue] -> Maybe CsvValue
firstMatch forall a b. (a -> b) -> a -> b
$ Journal -> [CsvValue]
journalAccountNamesDeclaredOrImplied Journal
j
firstMatch :: [CsvValue] -> Maybe CsvValue
firstMatch = case CsvValue -> Either String Regexp
toRegexCI forall a b. (a -> b) -> a -> b
$ String -> CsvValue
T.pack String
apat of
Right Regexp
re -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Regexp -> CsvValue -> Bool
regexMatchText Regexp
re)
Left String
_ -> forall a b. a -> b -> a
const forall a. Maybe a
Nothing
inclusive :: Bool
inclusive = Bool
True
thisacctq :: Query
thisacctq = Regexp -> Query
Acct forall a b. (a -> b) -> a -> b
$ (if Bool
inclusive then CsvValue -> Regexp
accountNameToAccountRegex else CsvValue -> Regexp
accountNameToAccountOnlyRegex) CsvValue
acct
ropts' :: ReportOpts
ropts' = (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) {
depth_ :: Maybe Int
depth_=forall a. Maybe a
Nothing
, balanceaccum_ :: BalanceAccumulation
balanceaccum_= BalanceAccumulation
Historical
, querystring_ :: [CsvValue]
querystring_ = [CsvValue]
querystr
}
wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
ropts'
ReportSpec
rspec' <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ReportOpts -> ReportSpec -> Either String ReportSpec
updateReportSpec ReportOpts
ropts' ReportSpec
rspec
let
items :: AccountTransactionsReport
items = ReportSpec -> Journal -> Query -> AccountTransactionsReport
accountTransactionsReport ReportSpec
rspec' Journal
j Query
thisacctq
items' :: AccountTransactionsReport
items' = (if ReportOpts -> Bool
empty_ ReportOpts
ropts' then forall a. a -> a
id else forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> e
fifth6)) forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse AccountTransactionsReport
items
render :: AccountTransactionsReport -> Text
render | String
fmtforall a. Eq a => a -> a -> Bool
==String
"txt" = CliOpts -> Query -> Query -> AccountTransactionsReport -> Text
accountTransactionsReportAsText CliOpts
opts (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
| String
fmtforall a. Eq a => a -> a -> Bool
==String
"csv" = CSV -> Text
printCSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv WhichDate
wd (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq
| String
fmtforall a. Eq a => a -> a -> Bool
==String
"json" = forall a. ToJSON a => a -> Text
toJsonText
| Bool
otherwise = forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String -> String
unsupportedOutputFormatError String
fmt
where
fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts
CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts forall a b. (a -> b) -> a -> b
$ AccountTransactionsReport -> Text
render AccountTransactionsReport
items'
accountTransactionsReportAsCsv :: WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv :: WhichDate -> Query -> Query -> AccountTransactionsReport -> CSV
accountTransactionsReportAsCsv WhichDate
wd Query
reportq Query
thisacctq AccountTransactionsReport
is =
[CsvValue
"txnidx",CsvValue
"date",CsvValue
"code",CsvValue
"description",CsvValue
"otheraccounts",CsvValue
"change",CsvValue
"balance"]
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (WhichDate
-> Query
-> Query
-> (Transaction, Transaction, Bool, CsvValue, MixedAmount,
MixedAmount)
-> [CsvValue]
accountTransactionsReportItemAsCsvRecord WhichDate
wd Query
reportq Query
thisacctq) AccountTransactionsReport
is
accountTransactionsReportItemAsCsvRecord :: WhichDate -> Query -> Query -> AccountTransactionsReportItem -> CsvRecord
accountTransactionsReportItemAsCsvRecord :: WhichDate
-> Query
-> Query
-> (Transaction, Transaction, Bool, CsvValue, MixedAmount,
MixedAmount)
-> [CsvValue]
accountTransactionsReportItemAsCsvRecord
WhichDate
wd Query
reportq Query
thisacctq
(t :: Transaction
t@Transaction{Integer
tindex :: Transaction -> Integer
tindex :: Integer
tindex,CsvValue
tcode :: Transaction -> CsvValue
tcode :: CsvValue
tcode,CsvValue
tdescription :: Transaction -> CsvValue
tdescription :: CsvValue
tdescription}, Transaction
_, Bool
_issplit, CsvValue
otheracctsstr, MixedAmount
change, MixedAmount
balance)
= [CsvValue
idx,CsvValue
date,CsvValue
tcode,CsvValue
tdescription,CsvValue
otheracctsstr,CsvValue
amt,CsvValue
bal]
where
idx :: CsvValue
idx = String -> CsvValue
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
tindex
date :: CsvValue
date = Day -> CsvValue
showDate forall a b. (a -> b) -> a -> b
$ WhichDate -> Query -> Query -> Transaction -> Day
transactionRegisterDate WhichDate
wd Query
reportq Query
thisacctq Transaction
t
amt :: CsvValue
amt = WideBuilder -> CsvValue
wbToText forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay MixedAmount
change
bal :: CsvValue
bal = WideBuilder -> CsvValue
wbToText forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay 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 forall a b. (a -> b) -> a -> b
$
Builder
title forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n' forall a. Semigroup a => a -> a -> a
<>
forall a.
Bool
-> CliOpts
-> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> Builder)
-> (a -> MixedAmount)
-> (a -> MixedAmount)
-> [a]
-> Builder
postingsOrTransactionsReportAsText Bool
alignAll CliOpts
copts Int
-> Int
-> ((Transaction, Transaction, Bool, CsvValue, MixedAmount,
MixedAmount),
[WideBuilder], [WideBuilder])
-> Builder
itemAsText forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> e
itemamt forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> f
itembal AccountTransactionsReport
items
where
alignAll :: Bool
alignAll = String -> RawOpts -> Bool
boolopt String
"align-all" forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
copts
itemAsText :: Int
-> Int
-> ((Transaction, Transaction, Bool, CsvValue, MixedAmount,
MixedAmount),
[WideBuilder], [WideBuilder])
-> Builder
itemAsText = CliOpts
-> Query
-> Query
-> Int
-> Int
-> ((Transaction, Transaction, Bool, CsvValue, 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
title :: Builder
title = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\CsvValue
s -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CsvValue -> Builder
TB.fromText [CsvValue
"Transactions in ", CsvValue
s, CsvValue
" and subaccounts:"]) Maybe CsvValue
macct
where
macct :: Maybe CsvValue
macct = case (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAcct Query
thisacctq of
Acct Regexp
r -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CsvValue -> CsvValue
T.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CsvValue -> CsvValue
T.dropEnd Int
5 forall a b. (a -> b) -> a -> b
$ Regexp -> CsvValue
reString Regexp
r
Query
_ -> forall a. Maybe a
Nothing
accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int
-> (AccountTransactionsReportItem, [WideBuilder], [WideBuilder])
-> TB.Builder
accountTransactionsReportItemAsText :: CliOpts
-> Query
-> Query
-> Int
-> Int
-> ((Transaction, Transaction, Bool, CsvValue, 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{CsvValue
tdescription :: CsvValue
tdescription :: Transaction -> CsvValue
tdescription}, Transaction
_, Bool
_issplit, CsvValue
otheracctsstr, MixedAmount
_, MixedAmount
_), [WideBuilder]
amt, [WideBuilder]
bal) =
Builder
table forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n'
where
table :: Builder
table = TableOpts -> Header Cell -> Builder
renderRowB forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False} forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall h. h -> Header h
Header
[ Align -> CsvValue -> Cell
textCell Align
TopLeft forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
fitText (forall a. a -> Maybe a
Just Int
datewidth) (forall a. a -> Maybe a
Just Int
datewidth) Bool
True Bool
True CsvValue
date
, Cell
spacerCell
, Align -> CsvValue -> Cell
textCell Align
TopLeft forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
fitText (forall a. a -> Maybe a
Just Int
descwidth) (forall a. a -> Maybe a
Just Int
descwidth) Bool
True Bool
True CsvValue
tdescription
, Cell
spacerCell2
, Align -> CsvValue -> Cell
textCell Align
TopLeft forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
fitText (forall a. a -> Maybe a
Just Int
acctwidth) (forall a. a -> Maybe a
Just Int
acctwidth) Bool
True Bool
True CsvValue
accts
, Cell
spacerCell2
, Align -> [WideBuilder] -> Cell
Cell Align
TopRight forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> WideBuilder -> WideBuilder
pad Int
amtwidth) [WideBuilder]
amt
, Cell
spacerCell2
, Align -> [WideBuilder] -> Cell
Cell Align
BottomRight forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> WideBuilder -> WideBuilder
pad Int
balwidth) [WideBuilder]
bal
]
spacerCell :: Cell
spacerCell = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
' ') Int
1]
spacerCell2 :: Cell
spacerCell2 = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [Builder -> Int -> WideBuilder
WideBuilder (String -> Builder
TB.fromString String
" ") Int
2]
pad :: Int -> WideBuilder -> WideBuilder
pad Int
fullwidth WideBuilder
amt1 = Builder -> Int -> WideBuilder
WideBuilder (CsvValue -> Builder
TB.fromText forall a b. (a -> b) -> a -> b
$ Int -> CsvValue -> CsvValue
T.replicate Int
w CsvValue
" ") Int
w forall a. Semigroup a => a -> a -> a
<> WideBuilder
amt1
where w :: Int
w = Int
fullwidth forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
amt1
(Int
totalwidth,Maybe Int
mdescwidth) = CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts
copts
(Int
datewidth, CsvValue
date) = (Int
10, Day -> CsvValue
showDate forall a b. (a -> b) -> a -> b
$ WhichDate -> Query -> Query -> Transaction -> Day
transactionRegisterDate WhichDate
wd Query
reportq Query
thisacctq Transaction
t)
where wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
ropts
(Int
amtwidth, Int
balwidth)
| Int
shortfall forall a. Ord a => a -> a -> Bool
<= Int
0 = (Int
preferredamtwidth, Int
preferredbalwidth)
| Bool
otherwise = (Int
adjustedamtwidth, Int
adjustedbalwidth)
where
mincolwidth :: Int
mincolwidth = Int
2
maxamtswidth :: Int
maxamtswidth = forall a. Ord a => a -> a -> a
max Int
0 (Int
totalwidth forall a. Num a => a -> a -> a
- (Int
datewidth forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
mincolwidth forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
mincolwidth forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2))
shortfall :: Int
shortfall = (Int
preferredamtwidth forall a. Num a => a -> a -> a
+ Int
preferredbalwidth) forall a. Num a => a -> a -> a
- Int
maxamtswidth
amtwidthproportion :: Double
amtwidthproportion = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
preferredamtwidth forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
preferredamtwidth forall a. Num a => a -> a -> a
+ Int
preferredbalwidth)
adjustedamtwidth :: Int
adjustedamtwidth = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
amtwidthproportion forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxamtswidth
adjustedbalwidth :: Int
adjustedbalwidth = Int
maxamtswidth forall a. Num a => a -> a -> a
- Int
adjustedamtwidth
remaining :: Int
remaining = Int
totalwidth forall a. Num a => a -> a -> a
- (Int
datewidth forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
amtwidth forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
balwidth)
(Int
descwidth, Int
acctwidth) = (Int
w, Int
remaining forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
- Int
w)
where w :: Int
w = forall a. a -> Maybe a -> a
fromMaybe ((Int
remaining forall a. Num a => a -> a -> a
- Int
2) forall a. Integral a => a -> a -> a
`div` Int
2) Maybe Int
mdescwidth
accts :: CsvValue
accts =
CsvValue
otheracctsstr
tests_Aregister :: TestTree
tests_Aregister = String -> [TestTree] -> TestTree
testGroup String
"Aregister" [
]