{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Register (
registermode
,register
,postingsReportAsText
,postingsReportItemAsText
,tests_Register
) where
import Data.Default (def)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.Builder as TB
import System.Console.CmdArgs.Explicit (flagNone, flagReq)
import Hledger hiding (per)
import Hledger.Read.CsvUtils (CSV, CsvRecord, printCSV, printTSV)
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Text.Tabular.AsciiWide hiding (render)
import Data.List (sortBy)
import Data.Char (toUpper)
import Data.List.Extra (intersect)
import System.Exit (exitFailure)
registermode :: Mode RawOpts
registermode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Register.txt")
([[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"cumulative"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"cumulative")
CommandDoc
"show running total from report start date (default)"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"historical",CommandDoc
"H"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"historical")
CommandDoc
"show historical running total/balance (includes postings before report start date)\n "
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"average",CommandDoc
"A"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"average")
CommandDoc
"show running average of posting amounts instead of total (implies --empty)"
,let arg :: CommandDoc
arg = CommandDoc
"DESC" in
[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq [CommandDoc
"match",CommandDoc
"m"] (\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
"match" CommandDoc
s RawOpts
opts) CommandDoc
arg
(CommandDoc
"fuzzy search for one recent posting with description closest to "CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
arg)
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"related",CommandDoc
"r"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"related") CommandDoc
"show postings' siblings instead"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"invert"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"invert") CommandDoc
"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] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"align-all"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"align-all") CommandDoc
"guarantee alignment across all lines (slower)"
,[CommandDoc] -> Flag RawOpts
outputFormatFlag [CommandDoc
"txt",CommandDoc
"csv",CommandDoc
"tsv",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
"[QUERY]")
register :: CliOpts -> Journal -> IO ()
register :: CliOpts -> Journal -> IO ()
register opts :: CliOpts
opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j
| Just CommandDoc
desc <- CommandDoc -> RawOpts -> Maybe CommandDoc
maybestringopt CommandDoc
"match" RawOpts
rawopts = do
let ps :: [Posting]
ps = [Posting
p | (Maybe Day
_,Maybe Period
_,Maybe Text
_,Posting
p,MixedAmount
_) <- PostingsReport
rpt]
case [Posting] -> CommandDoc -> Maybe Posting
similarPosting [Posting]
ps CommandDoc
desc of
Maybe Posting
Nothing -> CommandDoc -> IO ()
putStrLn CommandDoc
"no matches found." IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure
Just Posting
p -> Text -> IO ()
TL.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts [(Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
forall a. (Maybe Day, Maybe a, Maybe Text, Posting, MixedAmount)
pri]
where pri :: (Maybe Day, Maybe a, Maybe Text, Posting, MixedAmount)
pri = (Day -> Maybe Day
forall a. a -> Maybe a
Just (Posting -> Day
postingDate Posting
p)
,Maybe a
forall a. Maybe a
Nothing
,Transaction -> Text
tdescription (Transaction -> Text) -> Maybe Transaction -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Transaction
ptransaction Posting
p
,Map Text AmountStyle -> Posting -> Posting
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles Posting
p
,Map Text AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles MixedAmount
nullmixedamt)
| Bool
otherwise = CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ PostingsReport -> Text
render (PostingsReport -> Text) -> PostingsReport -> Text
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle -> PostingsReport -> PostingsReport
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles PostingsReport
rpt
where
styles :: Map Text AmountStyle
styles = Rounding -> Journal -> Map Text AmountStyle
journalCommodityStylesWith Rounding
HardRounding Journal
j
rpt :: PostingsReport
rpt = ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j
render :: PostingsReport -> Text
render | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"txt" = CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"csv" = [CsvRecord] -> Text
printCSV ([CsvRecord] -> Text)
-> (PostingsReport -> [CsvRecord]) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> [CsvRecord]
postingsReportAsCsv
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"tsv" = [CsvRecord] -> Text
printTSV ([CsvRecord] -> Text)
-> (PostingsReport -> [CsvRecord]) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> [CsvRecord]
postingsReportAsCsv
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"json" = PostingsReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
| Bool
otherwise = CommandDoc -> PostingsReport -> Text
forall a. CommandDoc -> a
error' (CommandDoc -> PostingsReport -> Text)
-> CommandDoc -> PostingsReport -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt
where fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv :: PostingsReport -> [CsvRecord]
postingsReportAsCsv PostingsReport
is =
[Text
"txnidx",Text
"date",Text
"code",Text
"description",Text
"account",Text
"amount",Text
"total"]
CsvRecord -> [CsvRecord] -> [CsvRecord]
forall a. a -> [a] -> [a]
:
((Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> CsvRecord)
-> PostingsReport -> [CsvRecord]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> CsvRecord
postingsReportItemAsCsvRecord PostingsReport
is
postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
postingsReportItemAsCsvRecord :: (Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> CsvRecord
postingsReportItemAsCsvRecord (Maybe Day
_, Maybe Period
_, Maybe Text
_, Posting
p, MixedAmount
b) = [Text
idx,Text
date,Text
code,Text
desc,Text
acct,Text
amt,Text
bal]
where
idx :: Text
idx = CommandDoc -> Text
T.pack (CommandDoc -> Text)
-> (Maybe Transaction -> CommandDoc) -> Maybe Transaction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Integer -> CommandDoc)
-> (Maybe Transaction -> Integer)
-> Maybe Transaction
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Transaction -> Integer) -> Maybe Transaction -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Transaction -> Integer
tindex (Maybe Transaction -> Text) -> Maybe Transaction -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
date :: Text
date = Day -> Text
showDate (Day -> Text) -> Day -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p
code :: Text
code = Text -> (Transaction -> Text) -> Maybe Transaction -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Transaction -> Text
tcode (Maybe Transaction -> Text) -> Maybe Transaction -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
desc :: Text
desc = Text -> (Transaction -> Text) -> Maybe Transaction -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Transaction -> Text
tdescription (Maybe Transaction -> Text) -> Maybe Transaction -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
acct :: Text
acct = Text -> Text
bracket (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Text
paccount Posting
p
where
bracket :: Text -> Text
bracket = case Posting -> PostingType
ptype Posting
p of
PostingType
BalancedVirtualPosting -> Text -> Text -> Text -> Text
wrap Text
"[" Text
"]"
PostingType
VirtualPosting -> Text -> Text -> Text -> Text
wrap Text
"(" Text
")"
PostingType
_ -> Text -> Text
forall a. a -> a
id
amt :: Text
amt = WideBuilder -> Text
wbToText (WideBuilder -> Text)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay (MixedAmount -> Text) -> MixedAmount -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
bal :: Text
bal = WideBuilder -> Text
wbToText (WideBuilder -> Text) -> WideBuilder -> Text
forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay MixedAmount
b
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
postingsReportAsText :: CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts = Builder -> Text
TB.toLazyText (Builder -> Text)
-> (PostingsReport -> Builder) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool
-> CliOpts
-> (Int
-> Int
-> ((Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount),
[WideBuilder], [WideBuilder])
-> Builder)
-> ((Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> MixedAmount)
-> ((Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> MixedAmount)
-> PostingsReport
-> Builder
forall a.
Bool
-> CliOpts
-> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> Builder)
-> (a -> MixedAmount)
-> (a -> MixedAmount)
-> [a]
-> Builder
postingsOrTransactionsReportAsText Bool
alignAll CliOpts
opts (CliOpts
-> Int
-> Int
-> ((Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount),
[WideBuilder], [WideBuilder])
-> Builder
postingsReportItemAsText CliOpts
opts) (Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> MixedAmount
forall a b c e. (a, b, c, Posting, e) -> MixedAmount
itemamt (Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> MixedAmount
forall a b c d e. (a, b, c, d, e) -> e
itembal
where
alignAll :: Bool
alignAll = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"align-all" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
itemamt :: (a, b, c, Posting, e) -> MixedAmount
itemamt (a
_,b
_,c
_,Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
a},e
_) = MixedAmount
a
itembal :: (a, b, c, d, e) -> e
itembal (a
_,b
_,c
_,d
_,e
a) = e
a
postingsReportItemAsText :: CliOpts -> Int -> Int
-> (PostingsReportItem, [WideBuilder], [WideBuilder])
-> TB.Builder
postingsReportItemAsText :: CliOpts
-> Int
-> Int
-> ((Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount),
[WideBuilder], [WideBuilder])
-> Builder
postingsReportItemAsText CliOpts
opts Int
preferredamtwidth Int
preferredbalwidth ((Maybe Day
mdate, Maybe Period
mperiod, Maybe Text
mdesc, Posting
p, MixedAmount
_), [WideBuilder]
amt, [WideBuilder]
bal) =
Builder
table Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n'
where
table :: Builder
table = TableOpts -> Header Cell -> Builder
renderRowB TableOpts
forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False} (Header Cell -> Builder)
-> ([Header Cell] -> Header Cell) -> [Header Cell] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Builder) -> [Header Cell] -> Builder
forall a b. (a -> b) -> a -> b
$ (Cell -> Header Cell) -> [Cell] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Header Cell
forall h. h -> Header h
Header
[ Align -> Text -> Cell
textCell Align
TopLeft (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) Bool
True Bool
True Text
date
, Cell
spacerCell
, Align -> Text -> Cell
textCell Align
TopLeft (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) Bool
True Bool
True Text
desc
, Cell
spacerCell2
, Align -> Text -> Cell
textCell Align
TopLeft (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctwidth) Bool
True Bool
True Text
acct
, Cell
spacerCell2
, Align -> [WideBuilder] -> Cell
Cell Align
TopRight ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> WideBuilder) -> [WideBuilder] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> WideBuilder -> WideBuilder
pad Int
amtwidth) [WideBuilder]
amt
, Cell
spacerCell2
, Align -> [WideBuilder] -> Cell
Cell Align
BottomRight ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ (WideBuilder -> WideBuilder) -> [WideBuilder] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> WideBuilder -> WideBuilder
pad Int
balwidth) [WideBuilder]
bal
]
spacerCell :: Cell
spacerCell = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [Builder -> Int -> WideBuilder
WideBuilder (Char -> Builder
TB.singleton Char
' ') Int
1]
spacerCell2 :: Cell
spacerCell2 = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft [Builder -> Int -> WideBuilder
WideBuilder (CommandDoc -> Builder
TB.fromString CommandDoc
" ") Int
2]
pad :: Int -> WideBuilder -> WideBuilder
pad Int
fullwidth WideBuilder
amt' = Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
w Text
" ") Int
w WideBuilder -> WideBuilder -> WideBuilder
forall a. Semigroup a => a -> a -> a
<> WideBuilder
amt'
where w :: Int
w = Int
fullwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
amt'
(Int
totalwidth,Maybe Int
mdescwidth) = CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts
opts
datewidth :: Int
datewidth = Int -> (Period -> Int) -> Maybe Period -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
10 Period -> Int
periodTextWidth Maybe Period
mperiod
date :: Text
date = case Maybe Period
mperiod of
Just Period
per -> if Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust Maybe Day
mdate then Period -> Text
showPeriod Period
per else Text
""
Maybe Period
Nothing -> Text -> (Day -> Text) -> Maybe Day -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Day -> Text
showDate Maybe Day
mdate
(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)
| Maybe Period -> Bool
forall a. Maybe a -> Bool
isJust Maybe Period
mperiod = (Int
0, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
| Bool
otherwise = (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
desc :: Text
desc = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mdesc
acct :: Text
acct = Text -> Text
parenthesise (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
elideAccountName Int
awidth (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Text
paccount Posting
p
where
(Text -> Text
parenthesise, Int
awidth) = case Posting -> PostingType
ptype Posting
p of
PostingType
BalancedVirtualPosting -> (Text -> Text -> Text -> Text
wrap Text
"[" Text
"]", Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
PostingType
VirtualPosting -> (Text -> Text -> Text -> Text
wrap Text
"(" Text
")", Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
PostingType
_ -> (Text -> Text
forall a. a -> a
id,Int
acctwidth)
similarPosting :: [Posting] -> String -> Maybe Posting
similarPosting :: [Posting] -> CommandDoc -> Maybe Posting
similarPosting [Posting]
ps CommandDoc
desc =
let matches :: [(Double, Posting)]
matches =
((Double, Posting) -> (Double, Posting) -> Ordering)
-> [(Double, Posting)] -> [(Double, Posting)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Double, Posting) -> (Double, Posting) -> Ordering
forall a. Ord a => (a, Posting) -> (a, Posting) -> Ordering
compareRelevanceAndRecency
([(Double, Posting)] -> [(Double, Posting)])
-> [(Double, Posting)] -> [(Double, Posting)]
forall a b. (a -> b) -> a -> b
$ ((Double, Posting) -> Bool)
-> [(Double, Posting)] -> [(Double, Posting)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
threshold)(Double -> Bool)
-> ((Double, Posting) -> Double) -> (Double, Posting) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Double, Posting) -> Double
forall a b. (a, b) -> a
fst)
[(Double -> (Transaction -> Double) -> Maybe Transaction -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\Transaction
t -> CommandDoc -> CommandDoc -> Double
compareDescriptions CommandDoc
desc (Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tdescription Transaction
t)) (Posting -> Maybe Transaction
ptransaction Posting
p), Posting
p) | Posting
p <- [Posting]
ps]
where
compareRelevanceAndRecency :: (a, Posting) -> (a, Posting) -> Ordering
compareRelevanceAndRecency (a
n1,Posting
p1) (a
n2,Posting
p2) = (a, Day) -> (a, Day) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a
n2,Posting -> Day
postingDate Posting
p2) (a
n1,Posting -> Day
postingDate Posting
p1)
threshold :: Double
threshold = Double
0
in case [(Double, Posting)]
matches of [] -> Maybe Posting
forall a. Maybe a
Nothing
(Double, Posting)
m:[(Double, Posting)]
_ -> Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ (Double, Posting) -> Posting
forall a b. (a, b) -> b
snd (Double, Posting)
m
compareDescriptions :: String -> String -> Double
compareDescriptions :: CommandDoc -> CommandDoc -> Double
compareDescriptions CommandDoc
s CommandDoc
t = CommandDoc -> CommandDoc -> Double
compareStrings CommandDoc
s' CommandDoc
t'
where s' :: CommandDoc
s' = CommandDoc -> CommandDoc
simplify CommandDoc
s
t' :: CommandDoc
t' = CommandDoc -> CommandDoc
simplify CommandDoc
t
simplify :: CommandDoc -> CommandDoc
simplify = (Char -> Bool) -> CommandDoc -> CommandDoc
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> CommandDoc -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CommandDoc
"0123456789"::String)))
compareStrings :: String -> String -> Double
compareStrings :: CommandDoc -> CommandDoc -> Double
compareStrings CommandDoc
"" CommandDoc
"" = Double
1
compareStrings [Char
_] CommandDoc
"" = Double
0
compareStrings CommandDoc
"" [Char
_] = Double
0
compareStrings [Char
a] [Char
b] = if Char -> Char
toUpper Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
b then Double
1 else Double
0
compareStrings CommandDoc
s1 CommandDoc
s2 = Double
2.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u
where
i :: Int
i = [CommandDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CommandDoc] -> Int) -> [CommandDoc] -> Int
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. Eq a => [a] -> [a] -> [a]
intersect [CommandDoc]
pairs1 [CommandDoc]
pairs2
u :: Int
u = [CommandDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommandDoc]
pairs1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [CommandDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommandDoc]
pairs2
pairs1 :: [CommandDoc]
pairs1 = CommandDoc -> [CommandDoc]
wordLetterPairs (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
uppercase CommandDoc
s1
pairs2 :: [CommandDoc]
pairs2 = CommandDoc -> [CommandDoc]
wordLetterPairs (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
uppercase CommandDoc
s2
wordLetterPairs :: CommandDoc -> [CommandDoc]
wordLetterPairs = (CommandDoc -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CommandDoc -> [CommandDoc]
forall a. [a] -> [[a]]
letterPairs ([CommandDoc] -> [CommandDoc])
-> (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> [CommandDoc]
words
letterPairs :: [a] -> [[a]]
letterPairs (a
a:a
b:[a]
rest) = [a
a,a
b] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
letterPairs (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)
letterPairs [a]
_ = []
tests_Register :: TestTree
tests_Register = CommandDoc -> [TestTree] -> TestTree
testGroup CommandDoc
"Register" [
CommandDoc -> [TestTree] -> TestTree
testGroup CommandDoc
"postingsReportAsText" [
CommandDoc -> IO () -> TestTree
testCase CommandDoc
"unicode in register layout" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Journal
j <- Text -> IO Journal
readJournal' Text
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let rspec :: ReportSpec
rspec = ReportSpec
defreportspec
(Text -> CommandDoc
TL.unpack (Text -> CommandDoc)
-> (PostingsReport -> Text) -> PostingsReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
defcliopts (PostingsReport -> CommandDoc) -> PostingsReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j)
CommandDoc -> CommandDoc -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
[CommandDoc] -> CommandDoc
unlines
[CommandDoc
"2009-01-01 медвежья шкура расходы:покупки 100 100"
,CommandDoc
" актив:наличные -100 0"]
]
]