{-|

A ledger-compatible @print@ command.

-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Cli.Commands.Print (
  printmode
 ,print'
 -- ,entriesReportAsText
 ,originalTransaction
)
where

import Data.Text (Text)
import qualified Data.Text as T
import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, printCSV)

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Cli.Commands.Add ( transactionsSimilarTo )


printmode :: Mode RawOpts
printmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Print.txt")
  ([let arg :: CommandDoc
arg = "STR" in
   [CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq  ["match","m"] (\s :: CommandDoc
s opts :: 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 "match" CommandDoc
s RawOpts
opts) CommandDoc
arg
    ("show the transaction whose description is most similar to "CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
argCommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++", and is most recent")
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["explicit","x"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "explicit")
    "show all amounts explicitly"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["new"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "new")
    "show only newer-dated transactions added in each file since last run"
  ] [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
outputflags)
  [(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 "[QUERY]")

-- | Print journal transactions in standard format.
print' :: CliOpts -> Journal -> IO ()
print' :: CliOpts -> Journal -> IO ()
print' opts :: CliOpts
opts j :: Journal
j = do
  case CommandDoc -> RawOpts -> Maybe CommandDoc
maybestringopt "match" (RawOpts -> Maybe CommandDoc) -> RawOpts -> Maybe CommandDoc
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts of
    Nothing   -> CliOpts -> Journal -> IO ()
printEntries CliOpts
opts Journal
j
    Just desc :: CommandDoc
desc -> CliOpts -> Journal -> Text -> IO ()
printMatch CliOpts
opts Journal
j (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Text
T.pack CommandDoc
desc

printEntries :: CliOpts -> Journal -> IO ()
printEntries :: CliOpts -> Journal -> IO ()
printEntries opts :: CliOpts
opts@CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
  Day
d <- IO Day
getCurrentDay
  let q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts
      fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
      (render :: EntriesReport -> CommandDoc
render, ropts' :: ReportOpts
ropts') = case CommandDoc
fmt of
        "csv"  -> ((CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"\n") (CommandDoc -> CommandDoc)
-> (EntriesReport -> CommandDoc) -> EntriesReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CommandDoc
printCSV (CSV -> CommandDoc)
-> (EntriesReport -> CSV) -> EntriesReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntriesReport -> CSV
entriesReportAsCsv, ReportOpts
ropts{accountlistmode_ :: AccountListMode
accountlistmode_=AccountListMode
ALFlat})
        "html" -> (CommandDoc -> EntriesReport -> CommandDoc
forall a b. a -> b -> a
const (CommandDoc -> EntriesReport -> CommandDoc)
-> CommandDoc -> EntriesReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
forall a. CommandDoc -> a
error' "Sorry, HTML output is not yet implemented for this kind of report.", ReportOpts
ropts{accountlistmode_ :: AccountListMode
accountlistmode_=AccountListMode
ALFlat})  -- TODO
        _      -> (CliOpts -> EntriesReport -> CommandDoc
entriesReportAsText CliOpts
opts,                 ReportOpts
ropts)
  CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ EntriesReport -> CommandDoc
render (EntriesReport -> CommandDoc) -> EntriesReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query -> Journal -> EntriesReport
entriesReport ReportOpts
ropts' Query
q Journal
j

entriesReportAsText :: CliOpts -> EntriesReport -> String
entriesReportAsText :: CliOpts -> EntriesReport -> CommandDoc
entriesReportAsText opts :: CliOpts
opts = (Transaction -> CommandDoc) -> EntriesReport -> CommandDoc
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Transaction -> CommandDoc
showTransaction (Transaction -> CommandDoc)
-> (Transaction -> Transaction) -> Transaction -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Transaction
gettxn)
  where
    gettxn :: Transaction -> Transaction
gettxn | Bool
useexplicittxn = Transaction -> Transaction
forall a. a -> a
id                   -- use fully inferred amounts & txn prices
           | Bool
otherwise      = Transaction -> Transaction
originalTransaction  -- use original as-written amounts/txn prices
    -- Original vs inferred transactions/postings were causing problems here, disabling -B (#551).
    -- Use the explicit one if -B or -x are active.
    -- This passes tests; does it also mean -B sometimes shows missing amounts unnecessarily ?
    useexplicittxn :: Bool
useexplicittxn = CommandDoc -> RawOpts -> Bool
boolopt "explicit" (CliOpts -> RawOpts
rawopts_ CliOpts
opts) Bool -> Bool -> Bool
|| (ReportOpts -> Bool
valuationTypeIsCost (ReportOpts -> Bool) -> ReportOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportOpts
reportopts_ CliOpts
opts)

-- Replace this transaction's postings with the original postings if any, but keep the
-- current possibly rewritten account names.
originalTransaction :: Transaction -> Transaction
originalTransaction t :: Transaction
t = Transaction
t { tpostings :: [Posting]
tpostings = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
originalPostingPreservingAccount ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t }

-- Get the original posting if any, but keep the current possibly rewritten account name.
originalPostingPreservingAccount :: Posting -> Posting
originalPostingPreservingAccount p :: Posting
p = (Posting -> Posting
originalPosting Posting
p) { paccount :: Text
paccount = Posting -> Text
paccount Posting
p }

-- XXX
-- tests_showTransactions = [
--   "showTransactions" ~: do

--    -- "print expenses" ~:
--    do
--     let opts = defreportopts{query_="expenses"}
--     d <- getCurrentDay
--     showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines
--      ["2008/06/03 * eat & shop"
--      ,"    expenses:food                $1"
--      ,"    expenses:supplies            $1"
--      ,"    assets:cash                 $-2"
--      ,""
--      ]

--   -- , "print report with depth arg" ~:
--    do
--     let opts = defreportopts{depth_=Just 2}
--     d <- getCurrentDay
--     showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines
--       ["2008/01/01 income"
--       ,"    assets:bank:checking            $1"
--       ,"    income:salary                  $-1"
--       ,""
--       ,"2008/06/01 gift"
--       ,"    assets:bank:checking            $1"
--       ,"    income:gifts                   $-1"
--       ,""
--       ,"2008/06/03 * eat & shop"
--       ,"    expenses:food                $1"
--       ,"    expenses:supplies            $1"
--       ,"    assets:cash                 $-2"
--       ,""
--       ,"2008/12/31 * pay off"
--       ,"    liabilities:debts               $1"
--       ,"    assets:bank:checking           $-1"
--       ,""
--       ]
--  ]

entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv txns :: EntriesReport
txns =
  ["txnidx","date","date2","status","code","description","comment","account","amount","commodity","credit","debit","posting-status","posting-comment"] [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
  (Transaction -> CSV) -> EntriesReport -> CSV
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> CSV
transactionToCSV EntriesReport
txns

-- | Generate one CSV record per posting, duplicating the common transaction fields.
-- The txnidx field (transaction index) allows postings to be grouped back into transactions.
transactionToCSV :: Transaction -> CSV
transactionToCSV :: Transaction -> CSV
transactionToCSV t :: Transaction
t =
  ([CommandDoc] -> [CommandDoc]) -> CSV -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (\p :: [CommandDoc]
p -> Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show Integer
idxCommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:CommandDoc
dateCommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:CommandDoc
date2CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:CommandDoc
statusCommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:CommandDoc
codeCommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:CommandDoc
descriptionCommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:CommandDoc
commentCommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:[CommandDoc]
p)
   ((Posting -> CSV) -> [Posting] -> CSV
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> CSV
postingToCSV ([Posting] -> CSV) -> [Posting] -> CSV
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
  where
    idx :: Integer
idx = Transaction -> Integer
tindex Transaction
t
    description :: CommandDoc
description = Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tdescription Transaction
t
    date :: CommandDoc
date = Day -> CommandDoc
showDate (Transaction -> Day
tdate Transaction
t)
    date2 :: CommandDoc
date2 = CommandDoc -> (Day -> CommandDoc) -> Maybe Day -> CommandDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Day -> CommandDoc
showDate (Transaction -> Maybe Day
tdate2 Transaction
t)
    status :: CommandDoc
status = Status -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Status -> CommandDoc) -> Status -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Transaction -> Status
tstatus Transaction
t
    code :: CommandDoc
code = Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t
    comment :: CommandDoc
comment = CommandDoc -> CommandDoc
chomp (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
strip (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcomment Transaction
t

postingToCSV :: Posting -> CSV
postingToCSV :: Posting -> CSV
postingToCSV p :: Posting
p =
  (Amount -> [CommandDoc]) -> [Amount] -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Amount
a@(Amount {aquantity :: Amount -> Quantity
aquantity=Quantity
q,acommodity :: Amount -> Text
acommodity=Text
c})) ->
    let a_ :: Amount
a_ = Amount
a{acommodity :: Text
acommodity=""} in
    let amount :: CommandDoc
amount = Amount -> CommandDoc
showAmount Amount
a_ in
    let commodity :: CommandDoc
commodity = Text -> CommandDoc
T.unpack Text
c in
    let credit :: CommandDoc
credit = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then Amount -> CommandDoc
showAmount (Amount -> CommandDoc) -> Amount -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
a_ else "" in
    let debit :: CommandDoc
debit  = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then Amount -> CommandDoc
showAmount Amount
a_ else "" in
    [CommandDoc
account, CommandDoc
amount, CommandDoc
commodity, CommandDoc
credit, CommandDoc
debit, CommandDoc
status, CommandDoc
comment])
   [Amount]
amounts
  where
    Mixed amounts :: [Amount]
amounts = Posting -> MixedAmount
pamount Posting
p
    status :: CommandDoc
status = Status -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Status -> CommandDoc) -> Status -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Posting -> Status
pstatus Posting
p
    account :: CommandDoc
account = Maybe Int -> PostingType -> Text -> CommandDoc
showAccountName Maybe Int
forall a. Maybe a
Nothing (Posting -> PostingType
ptype Posting
p) (Posting -> Text
paccount Posting
p)
    comment :: CommandDoc
comment = CommandDoc -> CommandDoc
chomp (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
strip (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Posting -> Text
pcomment Posting
p

-- --match

-- | Print the transaction most closely and recently matching a description
-- (and the query, if any).
printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j desc :: Text
desc = do
  Day
d <- IO Day
getCurrentDay
  let q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts
  case Journal -> Query -> Text -> Maybe Transaction
similarTransaction' Journal
j Query
q Text
desc of
                Nothing -> CommandDoc -> IO ()
putStrLn "no matches found."
                Just t :: Transaction
t  -> CommandDoc -> IO ()
putStr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> CommandDoc
showTransaction Transaction
t

  where
    -- Identify the closest recent match for this description in past transactions.
    similarTransaction' :: Journal -> Query -> Text -> Maybe Transaction
    similarTransaction' :: Journal -> Query -> Text -> Maybe Transaction
similarTransaction' j :: Journal
j q :: Query
q desc :: Text
desc
      | [(Double, Transaction)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Double, Transaction)]
historymatches = Maybe Transaction
forall a. Maybe a
Nothing
      | Bool
otherwise           = Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just (Transaction -> Maybe Transaction)
-> Transaction -> Maybe Transaction
forall a b. (a -> b) -> a -> b
$ (Double, Transaction) -> Transaction
forall a b. (a, b) -> b
snd ((Double, Transaction) -> Transaction)
-> (Double, Transaction) -> Transaction
forall a b. (a -> b) -> a -> b
$ [(Double, Transaction)] -> (Double, Transaction)
forall a. [a] -> a
head [(Double, Transaction)]
historymatches
      where
        historymatches :: [(Double, Transaction)]
historymatches = Journal -> Query -> Text -> [(Double, Transaction)]
transactionsSimilarTo Journal
j Query
q Text
desc