{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Print (
printmode
,print'
,originalTransaction
)
where
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.List (intercalate)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
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 = CommandDoc
"STR" in
[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq [CommandDoc
"match",CommandDoc
"m"] (\CommandDoc
s RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt CommandDoc
"match" CommandDoc
s RawOpts
opts) CommandDoc
arg
(CommandDoc
"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]
++CommandDoc
", and is most recent")
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"explicit",CommandDoc
"x"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"explicit")
CommandDoc
"show all amounts explicitly"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
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
([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")
print' :: CliOpts -> Journal -> IO ()
print' :: CliOpts -> Journal -> IO ()
print' CliOpts
opts Journal
j = do
case CommandDoc -> RawOpts -> Maybe CommandDoc
maybestringopt CommandDoc
"match" (RawOpts -> Maybe CommandDoc) -> RawOpts -> Maybe CommandDoc
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 -> 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{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = do
let fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
render :: EntriesReport -> CommandDoc
render = case CommandDoc
fmt of
CommandDoc
"txt" -> CliOpts -> EntriesReport -> CommandDoc
entriesReportAsText CliOpts
opts
CommandDoc
"csv" -> (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
"\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
CommandDoc
"json" -> (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
"\n") (CommandDoc -> CommandDoc)
-> (EntriesReport -> CommandDoc) -> EntriesReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CommandDoc
TL.unpack (Text -> CommandDoc)
-> (EntriesReport -> Text) -> EntriesReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntriesReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
CommandDoc
"sql" -> EntriesReport -> CommandDoc
entriesReportAsSql
CommandDoc
_ -> 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' (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt
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
$ ReportSpec -> Journal -> EntriesReport
entriesReport ReportSpec
rspec Journal
j
entriesReportAsText :: CliOpts -> EntriesReport -> String
entriesReportAsText :: CliOpts -> EntriesReport -> CommandDoc
entriesReportAsText 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
whichtxn)
where
whichtxn :: Transaction -> Transaction
whichtxn
| CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"explicit" (CliOpts -> RawOpts
rawopts_ CliOpts
opts)
Bool -> Bool -> Bool
|| (Maybe ValuationType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ValuationType -> Bool)
-> (ReportSpec -> Maybe ValuationType) -> ReportSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> Maybe ValuationType
value_ (ReportOpts -> Maybe ValuationType)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Maybe ValuationType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
rsOpts (ReportSpec -> Bool) -> ReportSpec -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts) = Transaction -> Transaction
forall a. a -> a
id
| Bool
otherwise = Transaction -> Transaction
originalTransaction
originalTransaction :: Transaction -> Transaction
originalTransaction 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 }
originalPostingPreservingAccount :: Posting -> Posting
originalPostingPreservingAccount Posting
p = (Posting -> Posting
originalPosting Posting
p) { paccount :: Text
paccount = Posting -> Text
paccount Posting
p }
entriesReportAsSql :: EntriesReport -> String
entriesReportAsSql :: EntriesReport -> CommandDoc
entriesReportAsSql EntriesReport
txns =
CommandDoc
"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"CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
CommandDoc
"insert into postings(txnidx,date1,date2,status,code,description,comment,account,amount,commodity,credit,debit,posting_status,posting_comment) values\n"CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
(CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate CommandDoc
"," (([CommandDoc] -> CommandDoc) -> CSV -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map [CommandDoc] -> CommandDoc
forall (t :: * -> *).
(Eq (t Char), IsString (t Char), Foldable t) =>
[t Char] -> CommandDoc
values CSV
csv))
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
";\n"
where
values :: [t Char] -> CommandDoc
values [t Char]
vs = CommandDoc
"(" CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ (CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate CommandDoc
"," ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ (t Char -> CommandDoc) -> [t Char] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map t Char -> CommandDoc
forall (t :: * -> *).
(Eq (t Char), IsString (t Char), Foldable t) =>
t Char -> CommandDoc
toSql [t Char]
vs) CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
")\n"
toSql :: t Char -> CommandDoc
toSql t Char
"" = CommandDoc
"NULL"
toSql t Char
s = CommandDoc
"'" CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ ((Char -> CommandDoc) -> t Char -> CommandDoc
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> CommandDoc
quoteChar t Char
s) CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
"'"
quoteChar :: Char -> CommandDoc
quoteChar Char
'\'' = CommandDoc
"''"
quoteChar Char
c = [Char
c]
csv :: CSV
csv = (Transaction -> CSV) -> EntriesReport -> CSV
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> CSV
transactionToCSV EntriesReport
txns
entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv EntriesReport
txns =
[CommandDoc
"txnidx",CommandDoc
"date",CommandDoc
"date2",CommandDoc
"status",CommandDoc
"code",CommandDoc
"description",CommandDoc
"comment",CommandDoc
"account",CommandDoc
"amount",CommandDoc
"commodity",CommandDoc
"credit",CommandDoc
"debit",CommandDoc
"posting-status",CommandDoc
"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
transactionToCSV :: Transaction -> CSV
transactionToCSV :: Transaction -> CSV
transactionToCSV Transaction
t =
([CommandDoc] -> [CommandDoc]) -> CSV -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (\[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 CommandDoc
"" 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 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=Text
"",astyle :: AmountStyle
astyle=(Amount -> AmountStyle
astyle Amount
a){asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
forall a. Maybe a
Nothing},aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing} 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
< Quantity
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 CommandDoc
"" in
let debit :: CommandDoc
debit = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
>= Quantity
0 then Amount -> CommandDoc
showAmount Amount
a_ else CommandDoc
"" in
[CommandDoc
account, CommandDoc
amount, CommandDoc
commodity, CommandDoc
credit, CommandDoc
debit, CommandDoc
status, CommandDoc
comment])
[Amount]
amounts
where
Mixed [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
printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j Text
desc = do
case Journal -> Query -> Text -> Maybe Transaction
similarTransaction' Journal
j (ReportSpec -> Query
rsQuery ReportSpec
rspec) Text
desc of
Maybe Transaction
Nothing -> CommandDoc -> IO ()
putStrLn CommandDoc
"no matches found."
Just Transaction
t -> CommandDoc -> IO ()
putStr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> CommandDoc
showTransaction Transaction
t
where
similarTransaction' :: Journal -> Query -> Text -> Maybe Transaction
similarTransaction' :: Journal -> Query -> Text -> Maybe Transaction
similarTransaction' Journal
j Query
q 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