{-|

A ledger-compatible @print@ command.

-}

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

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

import Data.List (intersperse)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Lens.Micro ((^.), _Just, has)
import System.Console.CmdArgs.Explicit

import Hledger
import Hledger.Read.CsvReader (CSV, printCSV)
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import System.Exit (exitFailure)


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 = CommandDoc
"DESC" in
   forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq  [CommandDoc
"match",CommandDoc
"m"] (\CommandDoc
s RawOpts
opts -> forall a b. b -> Either a b
Right 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 transaction with description closest to "forall a. [a] -> [a] -> [a]
++CommandDoc
arg)
  ,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"explicit",CommandDoc
"x"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"explicit")
    CommandDoc
"show all amounts explicitly"
  ,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"show-costs"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"show-costs")
    CommandDoc
"show transaction prices even with conversion postings"
  ,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"new"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"new")
    CommandDoc
"show only newer-dated transactions added in each file since last run"
  ,[CommandDoc] -> Flag RawOpts
outputFormatFlag [CommandDoc
"txt",CommandDoc
"csv",CommandDoc
"json",CommandDoc
"sql"]
  ,Flag RawOpts
outputFileFlag
  ])
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")

-- | Print journal transactions in standard format.
print' :: CliOpts -> Journal -> IO ()
print' :: CliOpts -> Journal -> IO ()
print' CliOpts
opts Journal
j = do
  -- The print command should show all amounts with their original decimal places,
  -- but as part of journal reading the posting amounts have already been normalised
  -- according to commodity display styles, and currently it's not easy to avoid
  -- that. For now we try to reverse it by increasing all amounts' decimal places 
  -- sufficiently to show the amount exactly. The displayed amounts may have minor
  -- differences from the originals, such as trailing zeroes added.
  let j' :: Journal
j' = (MixedAmount -> MixedAmount) -> Journal -> Journal
journalMapPostingAmounts MixedAmount -> MixedAmount
mixedAmountSetFullPrecision Journal
j
  case CommandDoc -> RawOpts -> Maybe CommandDoc
maybestringopt CommandDoc
"match" forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts of
    Maybe CommandDoc
Nothing   -> CliOpts -> Journal -> IO ()
printEntries CliOpts
opts Journal
j'
    Just CommandDoc
desc -> 
      -- match mode, prints one recent transaction most similar to given description
      -- XXX should match similarly to register --match
      case CliOpts -> Journal -> CsvValue -> Maybe Transaction
journalSimilarTransaction CliOpts
opts Journal
j' (forall a. Show a => CommandDoc -> a -> a
dbg1 CommandDoc
"finding best match for description" forall a b. (a -> b) -> a -> b
$ CommandDoc -> CsvValue
T.pack CommandDoc
desc) of
        Just Transaction
t  -> CliOpts -> Journal -> IO ()
printEntries CliOpts
opts Journal
j'{jtxns :: [Transaction]
jtxns=[Transaction
t]}
        Maybe Transaction
Nothing -> CommandDoc -> IO ()
putStrLn CommandDoc
"no matches found." forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure

printEntries :: CliOpts -> Journal -> IO ()
printEntries :: CliOpts -> Journal -> IO ()
printEntries opts :: CliOpts
opts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j =
  CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> Text
render forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> [Transaction]
entriesReport ReportSpec
rspec Journal
j
  where
    fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
    render :: [Transaction] -> Text
render | CommandDoc
fmtforall a. Eq a => a -> a -> Bool
==CommandDoc
"txt"  = CliOpts -> [Transaction] -> Text
entriesReportAsText CliOpts
opts
           | CommandDoc
fmtforall a. Eq a => a -> a -> Bool
==CommandDoc
"csv"  = CSV -> Text
printCSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> CSV
entriesReportAsCsv
           | CommandDoc
fmtforall a. Eq a => a -> a -> Bool
==CommandDoc
"json" = forall a. ToJSON a => a -> Text
toJsonText
           | CommandDoc
fmtforall a. Eq a => a -> a -> Bool
==CommandDoc
"sql"  = [Transaction] -> Text
entriesReportAsSql
           | Bool
otherwise   = forall a. CommandDoc -> a
error' forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt  -- PARTIAL:

entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text
entriesReportAsText :: CliOpts -> [Transaction] -> Text
entriesReportAsText CliOpts
opts =
    Builder -> Text
TB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CsvValue -> Builder
TB.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> CsvValue
showTransaction forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Transaction
whichtxn)
  where
    whichtxn :: Transaction -> Transaction
whichtxn
      -- With -x, use the fully-inferred txn with all amounts & txn prices explicit.
      | CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"explicit" (CliOpts -> RawOpts
rawopts_ CliOpts
opts) = forall a. a -> a
id
      -- With --show-costs, make txn prices explicit.
      | CliOpts
opts forall s a. s -> Getting a s a -> a
^. forall c. HasInputOpts c => Lens' c Bool
infer_costs = forall a. a -> a
id
      -- Or also, if any of -B/-V/-X/--value are active.
      -- Because of #551, and because of print -V valuing only one
      -- posting when there's an implicit txn price.
      -- So -B/-V/-X/--value implies -x. Is this ok ?
      | forall s a. Getting Any s a -> s -> Bool
has (forall c. HasReportOptsNoUpdate c => Lens' c (Maybe ValuationType)
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just) CliOpts
opts = forall a. a -> a
id
      -- By default, use the original as-written-in-the-journal txn.
      | Bool
otherwise = Transaction -> Transaction
originalTransaction

-- Replace this transaction's postings with the original postings if any, but keep the
-- current possibly rewritten account names, and the inferred values of any auto postings
originalTransaction :: Transaction -> Transaction
originalTransaction Transaction
t = Transaction
t { tpostings :: [Posting]
tpostings = forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
originalPostingPreservingAccount 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, and
-- the inferred values of any auto postings
originalPostingPreservingAccount :: Posting -> Posting
originalPostingPreservingAccount Posting
p = Posting
orig
    { paccount :: CsvValue
paccount = Posting -> CsvValue
paccount Posting
p
    , pamount :: MixedAmount
pamount = Posting -> MixedAmount
pamount forall a b. (a -> b) -> a -> b
$ if Bool
isGenerated then Posting
p else Posting
orig }
  where
    orig :: Posting
orig = Posting -> Posting
originalPosting Posting
p
    isGenerated :: Bool
isGenerated = CsvValue
"generated-posting" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (Posting -> [Tag]
ptags 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"
--       ,""
--       ]
--  ]

entriesReportAsSql :: EntriesReport -> TL.Text
entriesReportAsSql :: [Transaction] -> Text
entriesReportAsSql [Transaction]
txns = Builder -> Text
TB.toLazyText forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ CsvValue -> Builder
TB.fromText CsvValue
"create table if not exists postings(id serial,txnidx int,date1 date,date2 date,status text,code text,description text,comment text,account text,amount numeric,commodity text,credit numeric,debit numeric,posting_status text,posting_comment text);\n"
    , CsvValue -> Builder
TB.fromText CsvValue
"insert into postings(txnidx,date1,date2,status,code,description,comment,account,amount,commodity,credit,debit,posting_status,posting_comment) values\n"
    , forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (CsvValue -> Builder
TB.fromText CsvValue
",") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [CsvValue] -> Builder
values CSV
csv
    , CsvValue -> Builder
TB.fromText CsvValue
";\n"
    ]
  where
    values :: [CsvValue] -> Builder
values [CsvValue]
vs = CsvValue -> Builder
TB.fromText CsvValue
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (CsvValue -> Builder
TB.fromText CsvValue
",") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CsvValue -> Builder
toSql [CsvValue]
vs) forall a. Semigroup a => a -> a -> a
<> CsvValue -> Builder
TB.fromText CsvValue
")\n"
    toSql :: CsvValue -> Builder
toSql CsvValue
"" = CsvValue -> Builder
TB.fromText CsvValue
"NULL"
    toSql CsvValue
s  = CsvValue -> Builder
TB.fromText CsvValue
"'" forall a. Semigroup a => a -> a -> a
<> CsvValue -> Builder
TB.fromText (CsvValue -> CsvValue -> CsvValue -> CsvValue
T.replace CsvValue
"'" CsvValue
"''" CsvValue
s) forall a. Semigroup a => a -> a -> a
<> CsvValue -> Builder
TB.fromText CsvValue
"'"
    csv :: CSV
csv = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Transaction -> CSV
transactionToCSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MixedAmount -> MixedAmount) -> Transaction -> Transaction
transactionMapPostingAmounts ((Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount Amount -> Amount
setDecimalPoint)) [Transaction]
txns
      where
        setDecimalPoint :: Amount -> Amount
setDecimalPoint Amount
a = Amount
a{astyle :: AmountStyle
astyle=(Amount -> AmountStyle
astyle Amount
a){asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. a -> Maybe a
Just Char
'.'}}

entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv :: [Transaction] -> CSV
entriesReportAsCsv [Transaction]
txns =
  [CsvValue
"txnidx",CsvValue
"date",CsvValue
"date2",CsvValue
"status",CsvValue
"code",CsvValue
"description",CsvValue
"comment",CsvValue
"account",CsvValue
"amount",CsvValue
"commodity",CsvValue
"credit",CsvValue
"debit",CsvValue
"posting-status",CsvValue
"posting-comment"] forall a. a -> [a] -> [a]
:
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> CSV
transactionToCSV [Transaction]
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 Transaction
t =
  forall a b. (a -> b) -> [a] -> [b]
map (\[CsvValue]
p -> CommandDoc -> CsvValue
T.pack (forall a. Show a => a -> CommandDoc
show Integer
idx)forall a. a -> [a] -> [a]
:CsvValue
dforall a. a -> [a] -> [a]
:CsvValue
d2forall a. a -> [a] -> [a]
:CsvValue
statusforall a. a -> [a] -> [a]
:CsvValue
codeforall a. a -> [a] -> [a]
:CsvValue
descriptionforall a. a -> [a] -> [a]
:CsvValue
commentforall a. a -> [a] -> [a]
:[CsvValue]
p)
   (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> CSV
postingToCSV forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
  where
    idx :: Integer
idx = Transaction -> Integer
tindex Transaction
t
    description :: CsvValue
description = Transaction -> CsvValue
tdescription Transaction
t
    d :: CsvValue
d = Day -> CsvValue
showDate (Transaction -> Day
tdate Transaction
t)
    d2 :: CsvValue
d2 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvValue
"" Day -> CsvValue
showDate forall a b. (a -> b) -> a -> b
$ Transaction -> Maybe Day
tdate2 Transaction
t
    status :: CsvValue
status = CommandDoc -> CsvValue
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> CommandDoc
show forall a b. (a -> b) -> a -> b
$ Transaction -> Status
tstatus Transaction
t
    code :: CsvValue
code = Transaction -> CsvValue
tcode Transaction
t
    comment :: CsvValue
comment = CsvValue -> CsvValue
T.strip forall a b. (a -> b) -> a -> b
$ Transaction -> CsvValue
tcomment Transaction
t

postingToCSV :: Posting -> CSV
postingToCSV :: Posting -> CSV
postingToCSV Posting
p =
  forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Amount
a@(Amount {aquantity :: Amount -> Quantity
aquantity=Quantity
q,acommodity :: Amount -> CsvValue
acommodity=CsvValue
c})) ->
    -- commodity goes into separate column, so we suppress it, along with digit group
    -- separators and prices
    let a_ :: Amount
a_ = Amount -> Amount
amountStripPrices Amount
a{acommodity :: CsvValue
acommodity=CsvValue
""} in
    let showamt :: Amount -> CsvValue
showamt = WideBuilder -> CsvValue
wbToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
csvDisplay in
    let amt :: CsvValue
amt = Amount -> CsvValue
showamt Amount
a_ in
    let credit :: CsvValue
credit = if Quantity
q forall a. Ord a => a -> a -> Bool
< Quantity
0 then Amount -> CsvValue
showamt forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Amount
a_ else CsvValue
"" in
    let debit :: CsvValue
debit  = if Quantity
q forall a. Ord a => a -> a -> Bool
>= Quantity
0 then Amount -> CsvValue
showamt Amount
a_ else CsvValue
"" in
    [CsvValue
account, CsvValue
amt, CsvValue
c, CsvValue
credit, CsvValue
debit, CsvValue
status, CsvValue
comment])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
  where
    status :: CsvValue
status = CommandDoc -> CsvValue
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> CommandDoc
show forall a b. (a -> b) -> a -> b
$ Posting -> Status
pstatus Posting
p
    account :: CsvValue
account = Maybe Int -> PostingType -> CsvValue -> CsvValue
showAccountName forall a. Maybe a
Nothing (Posting -> PostingType
ptype Posting
p) (Posting -> CsvValue
paccount Posting
p)
    comment :: CsvValue
comment = CsvValue -> CsvValue
T.strip forall a b. (a -> b) -> a -> b
$ Posting -> CsvValue
pcomment Posting
p