{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Print (
printmode
,print'
,originalTransaction
)
where
import Data.Text (Text)
import Data.List (intersperse)
import qualified Data.Text as T
import qualified Data.Text.IO 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
printmode :: Mode RawOpts
printmode = String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Print.txt")
([let arg :: String
arg = String
"STR" 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
"show the transaction whose description is most similar to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
argString -> String -> String
forall a. [a] -> [a] -> [a]
++String
", and is most recent")
,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"explicit",String
"x"] (String -> RawOpts -> RawOpts
setboolopt String
"explicit")
String
"show all amounts explicitly"
,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"show-costs"] (String -> RawOpts -> RawOpts
setboolopt String
"show-costs")
String
"show transaction prices even with conversion postings"
,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"new"] (String -> RawOpts -> RawOpts
setboolopt String
"new")
String
"show only newer-dated transactions added in each file since last run"
,[String] -> Flag RawOpts
outputFormatFlag [String
"txt",String
"csv",String
"json",String
"sql"]
,Flag RawOpts
outputFileFlag
])
[(String, [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
$ String -> Arg RawOpts
argsFlag String
"[QUERY]")
print' :: CliOpts -> Journal -> IO ()
print' :: CliOpts -> Journal -> IO ()
print' CliOpts
opts Journal
j = do
let j' :: Journal
j' = (MixedAmount -> MixedAmount) -> Journal -> Journal
journalMapPostingAmounts MixedAmount -> MixedAmount
mixedAmountSetFullPrecision Journal
j
case String -> RawOpts -> Maybe String
maybestringopt String
"match" (RawOpts -> Maybe String) -> RawOpts -> Maybe String
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts of
Maybe String
Nothing -> CliOpts -> Journal -> IO ()
printEntries CliOpts
opts Journal
j'
Just String
desc -> CliOpts -> Journal -> CsvValue -> IO ()
printMatch CliOpts
opts Journal
j' (CsvValue -> IO ()) -> CsvValue -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CsvValue
T.pack (String -> CsvValue) -> String -> CsvValue
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. Show a => String -> a -> a
dbg1 String
"finding best match for description" String
desc
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 (Text -> IO ())
-> (EntriesReport -> Text) -> EntriesReport -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntriesReport -> Text
render (EntriesReport -> IO ()) -> EntriesReport -> IO ()
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> EntriesReport
entriesReport ReportSpec
rspec Journal
j
where
fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts
render :: EntriesReport -> Text
render | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"txt" = CliOpts -> EntriesReport -> Text
entriesReportAsText CliOpts
opts
| String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"csv" = CSV -> Text
printCSV (CSV -> Text) -> (EntriesReport -> CSV) -> EntriesReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntriesReport -> CSV
entriesReportAsCsv
| String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"json" = EntriesReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
| String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"sql" = EntriesReport -> Text
entriesReportAsSql
| Bool
otherwise = String -> EntriesReport -> Text
forall a. String -> a
error' (String -> EntriesReport -> Text)
-> String -> EntriesReport -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
unsupportedOutputFormatError String
fmt
entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text
entriesReportAsText :: CliOpts -> EntriesReport -> Text
entriesReportAsText CliOpts
opts =
Builder -> Text
TB.toLazyText (Builder -> Text)
-> (EntriesReport -> Builder) -> EntriesReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Builder) -> EntriesReport -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CsvValue -> Builder
TB.fromText (CsvValue -> Builder)
-> (Transaction -> CsvValue) -> Transaction -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> CsvValue
showTransaction (Transaction -> CsvValue)
-> (Transaction -> Transaction) -> Transaction -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Transaction
maybeStripPrices (Transaction -> Transaction)
-> (Transaction -> Transaction) -> Transaction -> Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Transaction
whichtxn)
where
whichtxn :: Transaction -> Transaction
whichtxn
| String -> RawOpts -> Bool
boolopt String
"explicit" (CliOpts -> RawOpts
rawopts_ CliOpts
opts) = Transaction -> Transaction
forall a. a -> a
id
| Getting Any CliOpts ValuationType -> CliOpts -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe ValuationType -> Const Any (Maybe ValuationType))
-> CliOpts -> Const Any CliOpts
forall c. HasReportOptsNoUpdate c => Lens' c (Maybe ValuationType)
value ((Maybe ValuationType -> Const Any (Maybe ValuationType))
-> CliOpts -> Const Any CliOpts)
-> ((ValuationType -> Const Any ValuationType)
-> Maybe ValuationType -> Const Any (Maybe ValuationType))
-> Getting Any CliOpts ValuationType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValuationType -> Const Any ValuationType)
-> Maybe ValuationType -> Const Any (Maybe ValuationType)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just) CliOpts
opts = Transaction -> Transaction
forall a. a -> a
id
| Bool
otherwise = Transaction -> Transaction
originalTransaction
maybeStripPrices :: Transaction -> Transaction
maybeStripPrices
| CliOpts
opts CliOpts -> Getting Bool CliOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool CliOpts Bool
forall c. HasInputOpts c => Lens' c Bool
infer_equity Bool -> Bool -> Bool
&& Bool -> Bool
not (CliOpts
opts CliOpts -> Getting Bool CliOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool CliOpts Bool
forall c. HasReportOptsNoUpdate c => Lens' c Bool
show_costs) =
(Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings Posting -> Posting
postingStripPrices
| Bool
otherwise = Transaction -> Transaction
forall a. a -> a
id
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
orig
{ paccount :: CsvValue
paccount = Posting -> CsvValue
paccount Posting
p
, pamount :: MixedAmount
pamount = Posting -> MixedAmount
pamount (Posting -> MixedAmount) -> Posting -> MixedAmount
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" CsvValue -> [CsvValue] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((CsvValue, CsvValue) -> CsvValue)
-> [(CsvValue, CsvValue)] -> [CsvValue]
forall a b. (a -> b) -> [a] -> [b]
map (CsvValue, CsvValue) -> CsvValue
forall a b. (a, b) -> a
fst (Posting -> [(CsvValue, CsvValue)]
ptags Posting
p)
entriesReportAsSql :: EntriesReport -> TL.Text
entriesReportAsSql :: EntriesReport -> Text
entriesReportAsSql EntriesReport
txns = Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
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"
, [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (CsvValue -> Builder
TB.fromText CsvValue
",") ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ ([CsvValue] -> Builder) -> CSV -> [Builder]
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
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (CsvValue -> Builder
TB.fromText CsvValue
",") ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (CsvValue -> Builder) -> [CsvValue] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CsvValue -> Builder
toSql [CsvValue]
vs) Builder -> Builder -> Builder
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
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CsvValue -> Builder
TB.fromText (CsvValue -> CsvValue -> CsvValue -> CsvValue
T.replace CsvValue
"'" CsvValue
"''" CsvValue
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CsvValue -> Builder
TB.fromText CsvValue
"'"
csv :: CSV
csv = (Transaction -> CSV) -> EntriesReport -> CSV
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Transaction -> CSV
transactionToCSV (Transaction -> CSV)
-> (Transaction -> Transaction) -> Transaction -> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MixedAmount -> MixedAmount) -> Transaction -> Transaction
transactionMapPostingAmounts ((Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount Amount -> Amount
setDecimalPoint)) EntriesReport
txns
where
setDecimalPoint :: Amount -> Amount
setDecimalPoint Amount
a = Amount
a{astyle :: AmountStyle
astyle=(Amount -> AmountStyle
astyle Amount
a){asdecimalpoint :: Maybe Char
asdecimalpoint=Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.'}}
entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv EntriesReport
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"] [CsvValue] -> 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 =
([CsvValue] -> [CsvValue]) -> CSV -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (\[CsvValue]
p -> String -> CsvValue
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
idx)CsvValue -> [CsvValue] -> [CsvValue]
forall a. a -> [a] -> [a]
:CsvValue
dateCsvValue -> [CsvValue] -> [CsvValue]
forall a. a -> [a] -> [a]
:CsvValue
date2CsvValue -> [CsvValue] -> [CsvValue]
forall a. a -> [a] -> [a]
:CsvValue
statusCsvValue -> [CsvValue] -> [CsvValue]
forall a. a -> [a] -> [a]
:CsvValue
codeCsvValue -> [CsvValue] -> [CsvValue]
forall a. a -> [a] -> [a]
:CsvValue
descriptionCsvValue -> [CsvValue] -> [CsvValue]
forall a. a -> [a] -> [a]
:CsvValue
commentCsvValue -> [CsvValue] -> [CsvValue]
forall a. a -> [a] -> [a]
:[CsvValue]
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 :: CsvValue
description = Transaction -> CsvValue
tdescription Transaction
t
date :: CsvValue
date = Day -> CsvValue
showDate (Transaction -> Day
tdate Transaction
t)
date2 :: CsvValue
date2 = CsvValue -> (Day -> CsvValue) -> Maybe Day -> CsvValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CsvValue
"" Day -> CsvValue
showDate (Maybe Day -> CsvValue) -> Maybe Day -> CsvValue
forall a b. (a -> b) -> a -> b
$ Transaction -> Maybe Day
tdate2 Transaction
t
status :: CsvValue
status = String -> CsvValue
T.pack (String -> CsvValue) -> (Status -> String) -> Status -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> String
forall a. Show a => a -> String
show (Status -> CsvValue) -> Status -> CsvValue
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 (CsvValue -> CsvValue) -> CsvValue -> CsvValue
forall a b. (a -> b) -> a -> b
$ Transaction -> CsvValue
tcomment Transaction
t
postingToCSV :: Posting -> CSV
postingToCSV :: Posting -> CSV
postingToCSV Posting
p =
(Amount -> [CsvValue]) -> [Amount] -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Amount
a@(Amount {aquantity :: Amount -> Quantity
aquantity=Quantity
q,acommodity :: Amount -> CsvValue
acommodity=CsvValue
c})) ->
let a_ :: Amount
a_ = Amount -> Amount
amountStripPrices Amount
a{acommodity :: CsvValue
acommodity=CsvValue
""} in
let showamt :: Amount -> CsvValue
showamt = WideBuilder -> CsvValue
wbToText (WideBuilder -> CsvValue)
-> (Amount -> WideBuilder) -> Amount -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
csvDisplay in
let amount :: CsvValue
amount = Amount -> CsvValue
showamt Amount
a_ in
let credit :: CsvValue
credit = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0 then Amount -> CsvValue
showamt (Amount -> CsvValue) -> Amount -> CsvValue
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
a_ else CsvValue
"" in
let debit :: CsvValue
debit = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
>= Quantity
0 then Amount -> CsvValue
showamt Amount
a_ else CsvValue
"" in
[CsvValue
account, CsvValue
amount, CsvValue
c, CsvValue
credit, CsvValue
debit, CsvValue
status, CsvValue
comment])
([Amount] -> CSV)
-> (MixedAmount -> [Amount]) -> MixedAmount -> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts (MixedAmount -> CSV) -> MixedAmount -> CSV
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
where
status :: CsvValue
status = String -> CsvValue
T.pack (String -> CsvValue) -> (Status -> String) -> Status -> CsvValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> String
forall a. Show a => a -> String
show (Status -> CsvValue) -> Status -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> Status
pstatus Posting
p
account :: CsvValue
account = Maybe Int -> PostingType -> CsvValue -> CsvValue
showAccountName Maybe Int
forall a. Maybe a
Nothing (Posting -> PostingType
ptype Posting
p) (Posting -> CsvValue
paccount Posting
p)
comment :: CsvValue
comment = CsvValue -> CsvValue
T.strip (CsvValue -> CsvValue) -> CsvValue -> CsvValue
forall a b. (a -> b) -> a -> b
$ Posting -> CsvValue
pcomment Posting
p
printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch :: CliOpts -> Journal -> CsvValue -> IO ()
printMatch CliOpts
opts Journal
j CsvValue
desc = do
case CliOpts -> Journal -> CsvValue -> Maybe Transaction
journalSimilarTransaction CliOpts
opts Journal
j CsvValue
desc of
Maybe Transaction
Nothing -> String -> IO ()
putStrLn String
"no matches found."
Just Transaction
t -> CsvValue -> IO ()
T.putStr (CsvValue -> IO ()) -> CsvValue -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> CsvValue
showTransaction Transaction
t