{-|

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 Data.Text (Text)
import qualified Data.Map as Map
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.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods)
import Hledger.Write.Html.Lucid (styledTableHtml)
import qualified Hledger.Write.Spreadsheet as Spr
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Cli.Anchor (setAccountAnchor, dateCell)
import Text.Tabular.AsciiWide (Cell(..), Align(..), Properties(..), Header(Header, Group), renderRowB, textCell, tableBorders, borderSpaces)
import qualified Lucid
import Data.List (sortBy)
import Data.Char (toUpper)
import Data.List.Extra (intersect)
import qualified System.IO as IO

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")
  ([[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"cumulative"] (String -> RawOpts -> RawOpts
setboolopt String
"cumulative")
     (String
accumprefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"show running total from report start date (default)")
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"historical",String
"H"] (String -> RawOpts -> RawOpts
setboolopt String
"historical")
     (String
accumprefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"show historical running total/balance (includes postings before report start date)")
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
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
   [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"match",String
"m"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
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 "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
arg)
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"related",String
"r"] (String -> RawOpts -> RawOpts
setboolopt String
"related") String
"show postings' siblings instead"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"invert"] (String -> RawOpts -> RawOpts
setboolopt String
"invert") String
"display all amounts with reversed sign"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"sort"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"sort" String
s RawOpts
opts) String
"FIELDS" 
    (String
"sort by: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sortKeysDescription
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", or a comma-separated combination of these. For a descending sort, prefix with -. (Default: date)")
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"width",String
"w"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
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: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
#ifdef mingw32_HOST_OS
      show defaultWidth
#else
      String
"terminal width"
#endif
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"). -wN,M sets description width as well."
     )
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
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] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"base-url"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"base-url" String
s RawOpts
opts) String
"URLPREFIX" String
"in html output, generate links to hledger-web, with this prefix. (Usually the base url shown by hledger-web; can also be relative.)"
  ,[String] -> Flag RawOpts
outputFormatFlag [String
"txt",String
"csv",String
"tsv",String
"html",String
"fods",String
"json"]
  ,Flag RawOpts
outputFileFlag
  ])
  [(String, [Flag RawOpts])]
cligeneralflagsgroups1
  [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
$ String -> Arg RawOpts
argsFlag String
"[QUERY]")
  where
    accumprefix :: String
accumprefix = String
"accumulation mode: "

-- | 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 Text
_,Posting
p,MixedAmount
_) <- PostingsReport
rpt]
      case [Posting] -> String -> Maybe Posting
similarPosting [Posting]
ps String
desc of
        Maybe Posting
Nothing -> String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"no postings found with description like " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
desc
        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)
  -- normal register report, list postings
  | 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 | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"txt"  = CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"json" = PostingsReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"csv"  = CSV -> Text
printCSV (CSV -> Text) -> (PostingsReport -> CSV) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> CSV
postingsReportAsCsv
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"tsv"  = CSV -> Text
printTSV (CSV -> Text) -> (PostingsReport -> CSV) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> CSV
postingsReportAsCsv
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"html" =
                (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text)
-> (PostingsReport -> Text) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html () -> Text
forall a. Html a -> Text
Lucid.renderText (Html () -> Text)
-> (PostingsReport -> Html ()) -> PostingsReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Cell NumLines (Html ())]] -> Html ()
forall border. Lines border => [[Cell border (Html ())]] -> Html ()
styledTableHtml ([[Cell NumLines (Html ())]] -> Html ())
-> (PostingsReport -> [[Cell NumLines (Html ())]])
-> PostingsReport
-> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                ([Cell NumLines Text] -> [Cell NumLines (Html ())])
-> [[Cell NumLines Text]] -> [[Cell NumLines (Html ())]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines Text -> Cell NumLines (Html ()))
-> [Cell NumLines Text] -> [Cell NumLines (Html ())]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Html ()) -> Cell NumLines Text -> Cell NumLines (Html ())
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
Lucid.toHtml)) ([[Cell NumLines Text]] -> [[Cell NumLines (Html ())]])
-> (PostingsReport -> [[Cell NumLines Text]])
-> PostingsReport
-> [[Cell NumLines (Html ())]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                AmountFormat
-> Maybe Text -> [Text] -> PostingsReport -> [[Cell NumLines Text]]
postingsReportAsSpreadsheet AmountFormat
oneLineNoCostFmt Maybe Text
baseUrl [Text]
query
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"fods" =
                TextEncoding
-> Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text
printFods TextEncoding
IO.localeEncoding (Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text)
-> (PostingsReport
    -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> PostingsReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ((Int, Int), [[Cell NumLines Text]])
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall k a. k -> a -> Map k a
Map.singleton Text
"Register" (((Int, Int), [[Cell NumLines Text]])
 -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> (PostingsReport -> ((Int, Int), [[Cell NumLines Text]]))
-> PostingsReport
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (,) (Int
1,Int
0) ([[Cell NumLines Text]] -> ((Int, Int), [[Cell NumLines Text]]))
-> (PostingsReport -> [[Cell NumLines Text]])
-> PostingsReport
-> ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                AmountFormat
-> Maybe Text -> [Text] -> PostingsReport -> [[Cell NumLines Text]]
postingsReportAsSpreadsheet AmountFormat
oneLineNoCostFmt Maybe Text
baseUrl [Text]
query
           | Bool
otherwise   = String -> PostingsReport -> Text
forall a. String -> a
error' (String -> PostingsReport -> Text)
-> String -> PostingsReport -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
unsupportedOutputFormatError String
fmt  -- PARTIAL:
      where fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts
            baseUrl :: Maybe Text
baseUrl = ReportOpts -> Maybe Text
balance_base_url_ (ReportOpts -> Maybe Text) -> ReportOpts -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
            query :: [Text]
query = ReportOpts -> [Text]
querystring_ (ReportOpts -> [Text]) -> ReportOpts -> [Text]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec

postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv =
  [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
Spr.rawTableContent ([[Cell NumLines Text]] -> CSV)
-> (PostingsReport -> [[Cell NumLines Text]])
-> PostingsReport
-> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat
-> Maybe Text -> [Text] -> PostingsReport -> [[Cell NumLines Text]]
postingsReportAsSpreadsheet AmountFormat
machineFmt Maybe Text
forall a. Maybe a
Nothing []

-- ToDo: --layout=bare etc.
-- ToDo: Text output does not show headers, but Spreadsheet does
postingsReportAsSpreadsheet ::
  AmountFormat -> Maybe Text -> [Text] ->
  PostingsReport -> [[Spr.Cell Spr.NumLines Text]]
postingsReportAsSpreadsheet :: AmountFormat
-> Maybe Text -> [Text] -> PostingsReport -> [[Cell NumLines Text]]
postingsReportAsSpreadsheet AmountFormat
fmt Maybe Text
baseUrl [Text]
query PostingsReport
is =
  [Cell () Text] -> [Cell NumLines Text]
forall text. [Cell () text] -> [Cell NumLines text]
Spr.addHeaderBorders
    ((Text -> Cell () Text) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell
      [Text
"txnidx",Text
"date",Text
"code",Text
"description",Text
"account",Text
"amount",Text
"total"])
  [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
:
  ((Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
 -> [Cell NumLines Text])
-> PostingsReport -> [[Cell NumLines Text]]
forall a b. (a -> b) -> [a] -> [b]
map (AmountFormat
-> Maybe Text
-> [Text]
-> (Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> [Cell NumLines Text]
forall border.
Lines border =>
AmountFormat
-> Maybe Text
-> [Text]
-> (Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> [Cell border Text]
postingsReportItemAsRecord AmountFormat
fmt Maybe Text
baseUrl [Text]
query) PostingsReport
is

{- ToDo:
link txnidx to journal URL,
   however, requires Web.Widget.Common.transactionFragment
-}
postingsReportItemAsRecord ::
    (Spr.Lines border) =>
    AmountFormat -> Maybe Text -> [Text] ->
    PostingsReportItem -> [Spr.Cell border Text]
postingsReportItemAsRecord :: forall border.
Lines border =>
AmountFormat
-> Maybe Text
-> [Text]
-> (Maybe Day, Maybe Period, Maybe Text, Posting, MixedAmount)
-> [Cell border Text]
postingsReportItemAsRecord AmountFormat
fmt Maybe Text
baseUrl [Text]
query (Maybe Day
_, Maybe Period
_, Maybe Text
_, Posting
p, MixedAmount
b) =
    [Cell border Text
idx,
     (Maybe Text -> [Text] -> Text -> Day -> Cell border Text
forall border.
Lines border =>
Maybe Text -> [Text] -> Text -> Day -> Cell border Text
dateCell Maybe Text
baseUrl [Text]
query (Posting -> Text
paccount Posting
p) Day
date) {Spr.cellType = Spr.TypeDate},
     Text -> Cell border Text
forall {text}. text -> Cell border text
cell Text
code, Text -> Cell border Text
forall {text}. text -> Cell border text
cell Text
desc,
     Maybe Text
-> [Text] -> Text -> Cell border Text -> Cell border Text
forall border text.
Maybe Text
-> [Text] -> Text -> Cell border text -> Cell border text
setAccountAnchor Maybe Text
baseUrl [Text]
query (Posting -> Text
paccount Posting
p) (Cell border Text -> Cell border Text)
-> Cell border Text -> Cell border Text
forall a b. (a -> b) -> a -> b
$ Text -> Cell border Text
forall {text}. text -> Cell border text
cell Text
acct,
     MixedAmount -> Cell border Text
forall {border}. Lines border => MixedAmount -> Cell border Text
amountCell (Posting -> MixedAmount
pamount Posting
p),
     MixedAmount -> Cell border Text
forall {border}. Lines border => MixedAmount -> Cell border Text
amountCell MixedAmount
b]
  where
    cell :: text -> Cell border text
cell = text -> Cell border text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell
    idx :: Cell border Text
idx  = Integer -> Cell border Text
forall border. Lines border => Integer -> Cell border Text
Spr.integerCell (Integer -> Cell border Text)
-> (Maybe Transaction -> Integer)
-> Maybe Transaction
-> Cell border Text
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 -> Cell border Text)
-> Maybe Transaction -> Cell border Text
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    date :: Day
date = Posting -> Day
postingDate Posting
p -- XXX csv should show date2 with --date2
    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
    -- Since postingsReport strips prices from all Amounts when not used, we can display prices.
    amountCell :: MixedAmount -> Cell border Text
amountCell MixedAmount
amt =
      WideBuilder -> Text
wbToText (WideBuilder -> Text)
-> Cell border WideBuilder -> Cell border Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AmountFormat -> (Class, MixedAmount) -> Cell border WideBuilder
forall border.
Lines border =>
AmountFormat -> (Class, MixedAmount) -> Cell border WideBuilder
Spr.cellFromMixedAmount AmountFormat
fmt (Text -> Class
Spr.Class Text
"amount", MixedAmount
amt)

-- | 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 (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 = String -> RawOpts -> Bool
boolopt String
"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

-- | 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 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=False, borderSpaces=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 (String -> Builder
TB.fromString String
"  ") 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'
    -- calculate widths
    (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 -- columns always show at least an ellipsis
        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 b. Integral b => Double -> b
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

    -- gather content
    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)

-- 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 =
          ((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 -> String -> String -> Double
compareDescriptions String
desc (Text -> String
T.unpack (Text -> String) -> Text -> String
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

-- -- 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 = (Char -> Bool) -> String -> String
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 -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Char -> Char -> Bool
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 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 = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
intersect [String]
pairs1 [String]
pairs2
      u :: Int
u = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
pairs1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
pairs2
      pairs1 :: [String]
pairs1 = String -> [String]
wordLetterPairs (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
uppercase String
s1
      pairs2 :: [String]
pairs2 = String -> [String]
wordLetterPairs (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
uppercase String
s2

wordLetterPairs :: String -> [String]
wordLetterPairs = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
forall {a}. [a] -> [[a]]
letterPairs ([String] -> [String])
-> (String -> [String]) -> String -> [String]
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] [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

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" (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 -> String
TL.unpack (Text -> String)
-> (PostingsReport -> Text) -> PostingsReport -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
defcliopts (PostingsReport -> String) -> PostingsReport -> String
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j)
        String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        [String] -> String
unlines
        [String
"2009-01-01 медвежья шкура       расходы:покупки                100           100"
        ,String
"                                актив:наличные                -100             0"]
   ]

 ]