{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Print (
printmode
,print'
,transactionWithMostlyOriginalPostings
)
where
import Data.List (intersperse, intercalate)
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.CsvUtils (CSV, printCSV, printTSV)
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import System.Exit (exitFailure)
import Safe (lastMay, minimumDef)
import Data.Function ((&))
import Data.List.Extra (nubSort)
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")
([forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"explicit",String
"x"] (String -> RawOpts -> RawOpts
setboolopt String
"explicit")
String
"show all amounts explicitly"
,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"
,forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"round"] (\String
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"round" String
s RawOpts
opts) String
"TYPE" forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
[String
"how much rounding or padding should be done when displaying amounts ?"
,String
"none - show original decimal digits,"
,String
" as in journal"
,String
"soft - just add or remove decimal zeros"
,String
" to match precision (default)"
,String
"hard - round posting amounts to precision"
,String
" (can unbalance transactions)"
,String
"all - also round cost amounts to precision"
,String
" (can unbalance transactions)"
]
,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"
,let arg :: String
arg = String
"DESC" in
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"match",String
"m"] (\String
s RawOpts
opts -> forall a b. b -> Either a b
Right 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 transaction with description closest to "forall a. [a] -> [a] -> [a]
++String
arg)
,[String] -> Flag RawOpts
outputFormatFlag [String
"txt",String
"beancount",String
"csv",String
"tsv",String
"json",String
"sql"]
,Flag RawOpts
outputFileFlag
])
[(String, [Flag RawOpts])
generalflagsgroup1]
[Flag RawOpts]
hiddenflags
([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Arg RawOpts
argsFlag String
"[QUERY]")
roundFromRawOpts :: RawOpts -> Maybe Rounding
roundFromRawOpts :: RawOpts -> Maybe Rounding
roundFromRawOpts = forall a. [a] -> Maybe a
lastMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts forall {a}. (Eq a, IsString a) => (a, String) -> Maybe Rounding
roundfromrawopt
where
roundfromrawopt :: (a, String) -> Maybe Rounding
roundfromrawopt (a
n,String
v)
| a
nforall a. Eq a => a -> a -> Bool
==a
"round", String
vforall a. Eq a => a -> a -> Bool
==String
"none" = forall a. a -> Maybe a
Just Rounding
NoRounding
| a
nforall a. Eq a => a -> a -> Bool
==a
"round", String
vforall a. Eq a => a -> a -> Bool
==String
"soft" = forall a. a -> Maybe a
Just Rounding
SoftRounding
| a
nforall a. Eq a => a -> a -> Bool
==a
"round", String
vforall a. Eq a => a -> a -> Bool
==String
"hard" = forall a. a -> Maybe a
Just Rounding
HardRounding
| a
nforall a. Eq a => a -> a -> Bool
==a
"round", String
vforall a. Eq a => a -> a -> Bool
==String
"all" = forall a. a -> Maybe a
Just Rounding
AllRounding
| a
nforall a. Eq a => a -> a -> Bool
==a
"round" = forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String
"--round's value should be none, soft, hard or all; got: "forall a. [a] -> [a] -> [a]
++String
v
| Bool
otherwise = forall a. Maybe a
Nothing
print' :: CliOpts -> Journal -> IO ()
print' :: CliOpts -> Journal -> IO ()
print' CliOpts
opts Journal
j = do
let
j' :: Journal
j' = Journal
j
forall a b. a -> (a -> b) -> b
& (MixedAmount -> MixedAmount) -> Journal -> Journal
journalMapPostingAmounts MixedAmount -> MixedAmount
mixedAmountSetFullPrecision
case String -> RawOpts -> Maybe String
maybestringopt String
"match" 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 ->
case CliOpts -> Journal -> CsvValue -> Maybe Transaction
journalSimilarTransaction CliOpts
opts Journal
j' (forall a. Show a => String -> a -> a
dbg1 String
"finding best match for description" forall a b. (a -> b) -> a -> b
$ String -> CsvValue
T.pack String
desc) of
Just Transaction
t -> CliOpts -> Journal -> IO ()
printEntries CliOpts
opts Journal
j'{jtxns :: [Transaction]
jtxns=[Transaction
t]}
Maybe Transaction
Nothing -> String -> IO ()
putStrLn String
"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{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j =
CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts forall a b. (a -> b) -> a -> b
$ [Transaction] -> Text
render forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> [Transaction]
entriesReport ReportSpec
rspec Journal
j
where
styles :: Map CsvValue AmountStyle
styles =
case RawOpts -> Maybe Rounding
roundFromRawOpts RawOpts
rawopts of
Maybe Rounding
Nothing -> Map CsvValue AmountStyle
styles0
Just Rounding
NoRounding -> Map CsvValue AmountStyle
styles0
Just Rounding
r -> Rounding -> Map CsvValue AmountStyle -> Map CsvValue AmountStyle
amountStylesSetRounding Rounding
r Map CsvValue AmountStyle
styles0
where styles0 :: Map CsvValue AmountStyle
styles0 = Journal -> Map CsvValue AmountStyle
journalCommodityStyles Journal
j
fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts
render :: [Transaction] -> Text
render | String
fmtforall a. Eq a => a -> a -> Bool
==String
"txt" = [Transaction] -> Text
entriesReportAsText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
maybeoriginalamounts
| String
fmtforall a. Eq a => a -> a -> Bool
==String
"beancount" = [Transaction] -> Text
entriesReportAsBeancount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
maybeoriginalamounts
| String
fmtforall a. Eq a => a -> a -> Bool
==String
"csv" = [CsvRecord] -> Text
printCSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> [CsvRecord]
entriesReportAsCsv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
| String
fmtforall a. Eq a => a -> a -> Bool
==String
"tsv" = [CsvRecord] -> Text
printTSV forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> [CsvRecord]
entriesReportAsCsv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
| String
fmtforall a. Eq a => a -> a -> Bool
==String
"json" = forall a. ToJSON a => a -> Text
toJsonText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
| String
fmtforall a. Eq a => a -> a -> Bool
==String
"sql" = [Transaction] -> Text
entriesReportAsSql forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
| Bool
otherwise = forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ String -> String
unsupportedOutputFormatError String
fmt
where
maybeoriginalamounts :: Transaction -> Transaction
maybeoriginalamounts
| String -> RawOpts -> Bool
boolopt String
"explicit" (CliOpts -> RawOpts
rawopts_ CliOpts
opts) = forall a. a -> a
id
| 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
| 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
| Bool
otherwise = Transaction -> Transaction
transactionWithMostlyOriginalPostings
transactionWithMostlyOriginalPostings :: Transaction -> Transaction
transactionWithMostlyOriginalPostings :: Transaction -> Transaction
transactionWithMostlyOriginalPostings = (Posting -> Posting) -> Transaction -> Transaction
transactionMapPostings Posting -> Posting
postingMostlyOriginal
where
postingMostlyOriginal :: Posting -> Posting
postingMostlyOriginal 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)
entriesReportAsText :: EntriesReport -> TL.Text
entriesReportAsText :: [Transaction] -> Text
entriesReportAsText = (Transaction -> CsvValue) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> CsvValue
showTransaction
entriesReportAsTextHelper :: (Transaction -> T.Text) -> EntriesReport -> TL.Text
entriesReportAsTextHelper :: (Transaction -> CsvValue) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> CsvValue
showtxn = 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
showtxn)
entriesReportAsBeancount :: EntriesReport -> TL.Text
entriesReportAsBeancount :: [Transaction] -> Text
entriesReportAsBeancount [Transaction]
ts =
Text
opendirectives forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
(Transaction -> CsvValue) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> CsvValue
showTransactionBeancount [Transaction]
ts
where
opendirectives :: Text
opendirectives
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts = Text
""
| Bool
otherwise = CsvValue -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$ CsvRecord -> CsvValue
T.unlines [
CsvValue
firstdate forall a. Semigroup a => a -> a -> a
<> CsvValue
" open " forall a. Semigroup a => a -> a -> a
<> CsvValue -> CsvValue
accountNameToBeancount CsvValue
a
| CsvValue
a <- forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map Posting -> CsvValue
paccountforall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> [Posting]
tpostings) [Transaction]
ts
]
where
firstdate :: CsvValue
firstdate = Day -> CsvValue
showDate forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> [a] -> a
minimumDef forall {a}. a
err forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate [Transaction]
ts
where err :: a
err = forall a. String -> a
error' String
"entriesReportAsBeancount: should not happen"
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 CsvRecord -> Builder
values [CsvRecord]
csv
, CsvValue -> Builder
TB.fromText CsvValue
";\n"
]
where
values :: CsvRecord -> Builder
values CsvRecord
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 CsvRecord
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 (HasCallStack => CsvValue -> CsvValue -> CsvValue -> CsvValue
T.replace CsvValue
"'" CsvValue
"''" CsvValue
s) forall a. Semigroup a => a -> a -> a
<> CsvValue -> Builder
TB.fromText CsvValue
"'"
csv :: [CsvRecord]
csv = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Transaction -> [CsvRecord]
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){asdecimalmark :: Maybe Char
asdecimalmark=forall a. a -> Maybe a
Just Char
'.'}}
entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv :: [Transaction] -> [CsvRecord]
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 -> [CsvRecord]
transactionToCSV [Transaction]
txns
transactionToCSV :: Transaction -> CSV
transactionToCSV :: Transaction -> [CsvRecord]
transactionToCSV Transaction
t =
forall a b. (a -> b) -> [a] -> [b]
map (\CsvRecord
p -> String -> CsvValue
T.pack (forall a. Show a => a -> String
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]
:CsvRecord
p)
(forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [CsvRecord]
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 = String -> CsvValue
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
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 -> [CsvRecord]
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})) ->
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 = String -> CsvValue
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
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