{-|

A ledger-compatible @register@ command.

-}

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

module Hledger.Cli.Commands.Register (
  registermode
 ,register
 ,postingsReportAsText
 ,postingsReportItemAsText
 -- ,showPostingWithBalanceForVty
 ,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 = String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Register.txt")
  ([forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"cumulative"] (String -> RawOpts -> RawOpts
setboolopt String
"cumulative")
     String
"show running total from report start date (default)"
  ,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"historical",String
"H"] (String -> RawOpts -> RawOpts
setboolopt String
"historical")
     String
"show historical running total/balance (includes postings before report start date)\n "
  ,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"average",String
"A"] (String -> RawOpts -> RawOpts
setboolopt String
"average")
     String
"show running average of posting amounts instead of total (implies --empty)"
  ,let arg :: String
arg = String
"DESC" in
   forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"match",String
"m"] (\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
"match" String
s RawOpts
opts) String
arg
    (String
"fuzzy search for one recent posting with description closest to "forall a. [a] -> [a] -> [a]
++String
arg)
  ,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"related",String
"r"] (String -> RawOpts -> RawOpts
setboolopt String
"related") String
"show postings' siblings instead"
  ,forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"invert"] (String -> RawOpts -> RawOpts
setboolopt String
"invert") String
"display all amounts with reversed sign"
  ,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
"tsv",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
"[QUERY]")

-- | Print a (posting) register report.
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
  -- match mode, print one recent posting most similar to given description, if any
  -- XXX should match similarly to print --match
  | Just String
desc <- String -> RawOpts -> Maybe String
maybestringopt String
"match" RawOpts
rawopts = do
      let ps :: [Posting]
ps = [Posting
p | (Maybe Day
_,Maybe Period
_,Maybe CsvValue
_,Posting
p,MixedAmount
_) <- PostingsReport
rpt]
      case [Posting] -> String -> Maybe Posting
similarPosting [Posting]
ps String
desc of
        Maybe Posting
Nothing -> String -> IO ()
putStrLn String
"no matches found." forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure
        Just Posting
p  -> Text -> IO ()
TL.putStr forall a b. (a -> b) -> a -> b
$ CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts [forall {a}.
(Maybe Day, Maybe a, Maybe CsvValue, Posting, MixedAmount)
pri]
                  where pri :: (Maybe Day, Maybe a, Maybe CsvValue, Posting, MixedAmount)
pri = (forall a. a -> Maybe a
Just (Posting -> Day
postingDate Posting
p)
                              ,forall a. Maybe a
Nothing
                              ,Transaction -> CsvValue
tdescription forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Transaction
ptransaction Posting
p
                              ,forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles Posting
p
                              ,forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles MixedAmount
nullmixedamt)
  -- normal register report, list postings
  | Bool
otherwise = CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts forall a b. (a -> b) -> a -> b
$ PostingsReport -> Text
render forall a b. (a -> b) -> a -> b
$ forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles PostingsReport
rpt
  where
    styles :: Map CsvValue AmountStyle
styles = Rounding -> Journal -> Map CsvValue AmountStyle
journalCommodityStylesWith Rounding
HardRounding Journal
j
    rpt :: PostingsReport
rpt = ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j
    render :: PostingsReport -> Text
render | String
fmtforall a. Eq a => a -> a -> Bool
==String
"txt"  = CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts
           | String
fmtforall a. Eq a => a -> a -> Bool
==String
"csv"  = [CsvRecord] -> Text
printCSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> [CsvRecord]
postingsReportAsCsv
           | String
fmtforall a. Eq a => a -> a -> Bool
==String
"tsv"  = [CsvRecord] -> Text
printTSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> [CsvRecord]
postingsReportAsCsv
           | 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  -- PARTIAL:
      where fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts

postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv :: PostingsReport -> [CsvRecord]
postingsReportAsCsv PostingsReport
is =
  [CsvValue
"txnidx",CsvValue
"date",CsvValue
"code",CsvValue
"description",CsvValue
"account",CsvValue
"amount",CsvValue
"total"]
  forall a. a -> [a] -> [a]
:
  forall a b. (a -> b) -> [a] -> [b]
map (Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
-> CsvRecord
postingsReportItemAsCsvRecord PostingsReport
is

postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
postingsReportItemAsCsvRecord :: (Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
-> CsvRecord
postingsReportItemAsCsvRecord (Maybe Day
_, Maybe Period
_, Maybe CsvValue
_, Posting
p, MixedAmount
b) = [CsvValue
idx,CsvValue
date,CsvValue
code,CsvValue
desc,CsvValue
acct,CsvValue
amt,CsvValue
bal]
  where
    idx :: CsvValue
idx  = String -> CsvValue
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Transaction -> Integer
tindex forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    date :: CsvValue
date = Day -> CsvValue
showDate forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p -- XXX csv should show date2 with --date2
    code :: CsvValue
code = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvValue
"" Transaction -> CsvValue
tcode forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    desc :: CsvValue
desc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvValue
"" Transaction -> CsvValue
tdescription forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    acct :: CsvValue
acct = CsvValue -> CsvValue
bracket forall a b. (a -> b) -> a -> b
$ Posting -> CsvValue
paccount Posting
p
      where
        bracket :: CsvValue -> CsvValue
bracket = case Posting -> PostingType
ptype Posting
p of
                             PostingType
BalancedVirtualPosting -> CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"[" CsvValue
"]"
                             PostingType
VirtualPosting -> CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"(" CsvValue
")"
                             PostingType
_ -> forall a. a -> a
id
    -- Since postingsReport strips prices from all Amounts when not used, we can display prices.
    amt :: CsvValue
amt = WideBuilder -> CsvValue
wbToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
    bal :: CsvValue
bal = WideBuilder -> CsvValue
wbToText forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
csvDisplay MixedAmount
b

-- | Render a register report as plain text suitable for console output.
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
postingsReportAsText :: CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts = Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    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 CsvValue, Posting,
     MixedAmount),
    [WideBuilder], [WideBuilder])
-> Builder
postingsReportItemAsText CliOpts
opts) forall {a} {b} {c} {e}. (a, b, c, Posting, e) -> MixedAmount
itemamt forall {a} {b} {c} {d} {e}. (a, b, c, d, e) -> e
itembal
  where
    alignAll :: Bool
alignAll = String -> RawOpts -> Bool
boolopt String
"align-all" 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

-- | Render one register report line item as plain text. Layout is like so:
-- @
-- <---------------- width (specified, terminal width, or 80) -------------------->
-- date (10)  description           account              amount (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.
--
-- With a report interval, the layout is like so:
-- @
-- <---------------- width (specified, terminal width, or 80) -------------------->
-- date (21)              account                        amount (12)   balance (12)
-- DDDDDDDDDDDDDDDDDDDDD  aaaaaaaaaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
-- @
--
-- date and description are shown for the first posting of a transaction only.
--
-- Returns a string which can be multi-line, eg if the running balance
-- has multiple commodities. Does not yet support formatting control
-- like balance reports.
--
-- Also returns the natural width (without padding) of the amount and balance
-- fields.
postingsReportItemAsText :: CliOpts -> Int -> Int
                         -> (PostingsReportItem, [WideBuilder], [WideBuilder])
                         -> TB.Builder
postingsReportItemAsText :: CliOpts
-> Int
-> Int
-> ((Maybe Day, Maybe Period, Maybe CsvValue, Posting,
     MixedAmount),
    [WideBuilder], [WideBuilder])
-> Builder
postingsReportItemAsText CliOpts
opts Int
preferredamtwidth Int
preferredbalwidth ((Maybe Day
mdate, Maybe Period
mperiod, Maybe CsvValue
mdesc, Posting
p, 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
desc
      , 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
acct
      , 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
amt' = 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
amt'
      where w :: Int
w = Int
fullwidth forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
amt'
    -- calculate widths
    (Int
totalwidth,Maybe Int
mdescwidth) = CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts
opts
    datewidth :: Int
datewidth = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
10 Period -> Int
periodTextWidth Maybe Period
mperiod
    date :: CsvValue
date = case Maybe Period
mperiod of
             Just Period
per -> if forall a. Maybe a -> Bool
isJust Maybe Day
mdate then Period -> CsvValue
showPeriod Period
per else CsvValue
""
             Maybe Period
Nothing  -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvValue
"" Day -> CsvValue
showDate Maybe Day
mdate
    (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 -- columns always show at least an ellipsis
        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)
      | forall a. Maybe a -> Bool
isJust Maybe Period
mperiod = (Int
0, Int
remaining forall a. Num a => a -> a -> a
- Int
2)
      | Bool
otherwise      = (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

    -- gather content
    desc :: CsvValue
desc = forall a. a -> Maybe a -> a
fromMaybe CsvValue
"" Maybe CsvValue
mdesc
    acct :: CsvValue
acct = CsvValue -> CsvValue
parenthesise forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CsvValue -> CsvValue
elideAccountName Int
awidth forall a b. (a -> b) -> a -> b
$ Posting -> CsvValue
paccount Posting
p
      where
        (CsvValue -> CsvValue
parenthesise, Int
awidth) = case Posting -> PostingType
ptype Posting
p of
            PostingType
BalancedVirtualPosting -> (CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"[" CsvValue
"]", Int
acctwidthforall a. Num a => a -> a -> a
-Int
2)
            PostingType
VirtualPosting         -> (CsvValue -> CsvValue -> CsvValue -> CsvValue
wrap CsvValue
"(" CsvValue
")", Int
acctwidthforall a. Num a => a -> a -> a
-Int
2)
            PostingType
_                      -> (forall a. a -> a
id,Int
acctwidth)

-- for register --match:

-- Identify the closest recent match for this description in the given date-sorted postings.
similarPosting :: [Posting] -> String -> Maybe Posting
similarPosting :: [Posting] -> String -> Maybe Posting
similarPosting [Posting]
ps String
desc =
  let matches :: [(Double, Posting)]
matches =
          forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a}. Ord a => (a, Posting) -> (a, Posting) -> Ordering
compareRelevanceAndRecency
                     forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Double
threshold)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst)
                     [(forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\Transaction
t -> String -> String -> Double
compareDescriptions String
desc (CsvValue -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Transaction -> CsvValue
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) = 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 []  -> forall a. Maybe a
Nothing
                     (Double, Posting)
m:[(Double, Posting)]
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Double, Posting)
m

-- -- Identify the closest recent match for this description in past transactions.
-- similarTransaction :: Journal -> Query -> String -> Maybe Transaction
-- similarTransaction j q desc =
--   case historymatches = transactionsSimilarTo j q desc of
--     ((,t):_) = Just t
--     []       = Nothing

compareDescriptions :: String -> String -> Double
compareDescriptions :: String -> String -> Double
compareDescriptions String
s String
t = String -> String -> Double
compareStrings String
s' String
t'
    where s' :: String
s' = String -> String
simplify String
s
          t' :: String
t' = String -> String
simplify String
t
          simplify :: String -> String
simplify = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"0123456789"::String)))

-- | Return a similarity measure, from 0 to 1, for two strings.
-- This is Simon White's letter pairs algorithm from
-- http://www.catalysoft.com/articles/StrikeAMatch.html
-- with a modification for short strings.
compareStrings :: String -> String -> Double
compareStrings :: String -> String -> Double
compareStrings String
"" String
"" = Double
1
compareStrings [Char
_] String
"" = Double
0
compareStrings String
"" [Char
_] = Double
0
compareStrings [Char
a] [Char
b] = if Char -> Char
toUpper Char
a forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
b then Double
1 else Double
0
compareStrings String
s1 String
s2 = Double
2.0 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u
    where
      i :: Int
i = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
intersect [String]
pairs1 [String]
pairs2
      u :: Int
u = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
pairs1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
pairs2
      pairs1 :: [String]
pairs1 = String -> [String]
wordLetterPairs forall a b. (a -> b) -> a -> b
$ String -> String
uppercase String
s1
      pairs2 :: [String]
pairs2 = String -> [String]
wordLetterPairs forall a b. (a -> b) -> a -> b
$ String -> String
uppercase String
s2

wordLetterPairs :: String -> [String]
wordLetterPairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. [a] -> [[a]]
letterPairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

letterPairs :: [a] -> [[a]]
letterPairs (a
a:a
b:[a]
rest) = [a
a,a
b] forall a. a -> [a] -> [a]
: [a] -> [[a]]
letterPairs (a
bforall a. a -> [a] -> [a]
:[a]
rest)
letterPairs [a]
_ = []

-- tests

tests_Register :: TestTree
tests_Register = String -> [TestTree] -> TestTree
testGroup String
"Register" [

   String -> [TestTree] -> TestTree
testGroup String
"postingsReportAsText" [
    String -> IO () -> TestTree
testCase String
"unicode in register layout" forall a b. (a -> b) -> a -> b
$ do
      Journal
j <- CsvValue -> IO Journal
readJournal' CsvValue
"2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
      let rspec :: ReportSpec
rspec = ReportSpec
defreportspec
      (Text -> String
TL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
defcliopts forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j)
        forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        [String] -> String
unlines
        [String
"2009-01-01 медвежья шкура       расходы:покупки                100           100"
        ,String
"                                актив:наличные                -100             0"]
   ]

 ]