{-# 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 = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Print.txt")
([[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
"show-costs"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"show-costs")
CommandDoc
"show transaction prices even with conversion postings"
,[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq [CommandDoc
"round"] (\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
"round" CommandDoc
s RawOpts
opts) CommandDoc
"TYPE" (CommandDoc -> Flag RawOpts) -> CommandDoc -> Flag RawOpts
forall a b. (a -> b) -> a -> b
$
CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate CommandDoc
"\n"
[CommandDoc
"how much rounding or padding should be done when displaying amounts ?"
,CommandDoc
"none - show original decimal digits,"
,CommandDoc
" as in journal"
,CommandDoc
"soft - just add or remove decimal zeros"
,CommandDoc
" to match precision (default)"
,CommandDoc
"hard - round posting amounts to precision"
,CommandDoc
" (can unbalance transactions)"
,CommandDoc
"all - also round cost amounts to precision"
,CommandDoc
" (can unbalance transactions)"
]
,[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"
,let arg :: CommandDoc
arg = CommandDoc
"DESC" 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
"fuzzy search for one recent transaction with description closest to "CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
arg)
,[CommandDoc] -> Flag RawOpts
outputFormatFlag [CommandDoc
"txt",CommandDoc
"beancount",CommandDoc
"csv",CommandDoc
"tsv",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]")
roundFromRawOpts :: RawOpts -> Maybe Rounding
roundFromRawOpts :: RawOpts -> Maybe Rounding
roundFromRawOpts = [Rounding] -> Maybe Rounding
forall a. [a] -> Maybe a
lastMay ([Rounding] -> Maybe Rounding)
-> (RawOpts -> [Rounding]) -> RawOpts -> Maybe Rounding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CommandDoc, CommandDoc) -> Maybe Rounding)
-> RawOpts -> [Rounding]
forall a. ((CommandDoc, CommandDoc) -> Maybe a) -> RawOpts -> [a]
collectopts (CommandDoc, CommandDoc) -> Maybe Rounding
forall a. (Eq a, IsString a) => (a, CommandDoc) -> Maybe Rounding
roundfromrawopt
where
roundfromrawopt :: (a, CommandDoc) -> Maybe Rounding
roundfromrawopt (a
n,CommandDoc
v)
| a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
"round", CommandDoc
vCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"none" = Rounding -> Maybe Rounding
forall a. a -> Maybe a
Just Rounding
NoRounding
| a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
"round", CommandDoc
vCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"soft" = Rounding -> Maybe Rounding
forall a. a -> Maybe a
Just Rounding
SoftRounding
| a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
"round", CommandDoc
vCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"hard" = Rounding -> Maybe Rounding
forall a. a -> Maybe a
Just Rounding
HardRounding
| a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
"round", CommandDoc
vCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"all" = Rounding -> Maybe Rounding
forall a. a -> Maybe a
Just Rounding
AllRounding
| a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
"round" = CommandDoc -> Maybe Rounding
forall a. CommandDoc -> a
error' (CommandDoc -> Maybe Rounding) -> CommandDoc -> Maybe Rounding
forall a b. (a -> b) -> a -> b
$ CommandDoc
"--round's value should be none, soft, hard or all; got: "CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
v
| Bool
otherwise = Maybe Rounding
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
Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
& (MixedAmount -> MixedAmount) -> Journal -> Journal
journalMapPostingAmounts MixedAmount -> MixedAmount
mixedAmountSetFullPrecision
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 ->
case CliOpts -> Journal -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
opts Journal
j' (CommandDoc -> Text -> Text
forall a. Show a => CommandDoc -> a -> a
dbg1 CommandDoc
"finding best match for description" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Text
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." IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
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 (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Transaction] -> Text
render ([Transaction] -> Text) -> [Transaction] -> Text
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> [Transaction]
entriesReport ReportSpec
rspec Journal
j
where
styles :: Map Text AmountStyle
styles =
case RawOpts -> Maybe Rounding
roundFromRawOpts RawOpts
rawopts of
Maybe Rounding
Nothing -> Map Text AmountStyle
styles0
Just Rounding
NoRounding -> Map Text AmountStyle
styles0
Just Rounding
r -> Rounding -> Map Text AmountStyle -> Map Text AmountStyle
amountStylesSetRounding Rounding
r Map Text AmountStyle
styles0
where styles0 :: Map Text AmountStyle
styles0 = Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j
fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
render :: [Transaction] -> Text
render | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"txt" = [Transaction] -> Text
entriesReportAsText ([Transaction] -> Text)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles ([Transaction] -> [Transaction])
-> ([Transaction] -> [Transaction])
-> [Transaction]
-> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
maybeoriginalamounts
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"beancount" = [Transaction] -> Text
entriesReportAsBeancount ([Transaction] -> Text)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles ([Transaction] -> [Transaction])
-> ([Transaction] -> [Transaction])
-> [Transaction]
-> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
maybeoriginalamounts
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"csv" = [CsvRecord] -> Text
printCSV ([CsvRecord] -> Text)
-> ([Transaction] -> [CsvRecord]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> [CsvRecord]
entriesReportAsCsv ([Transaction] -> [CsvRecord])
-> ([Transaction] -> [Transaction]) -> [Transaction] -> [CsvRecord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"tsv" = [CsvRecord] -> Text
printTSV ([CsvRecord] -> Text)
-> ([Transaction] -> [CsvRecord]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> [CsvRecord]
entriesReportAsCsv ([Transaction] -> [CsvRecord])
-> ([Transaction] -> [Transaction]) -> [Transaction] -> [CsvRecord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"json" = [Transaction] -> Text
forall a. ToJSON a => a -> Text
toJsonText ([Transaction] -> Text)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles
| CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"sql" = [Transaction] -> Text
entriesReportAsSql ([Transaction] -> Text)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles
| Bool
otherwise = CommandDoc -> [Transaction] -> Text
forall a. CommandDoc -> a
error' (CommandDoc -> [Transaction] -> Text)
-> CommandDoc -> [Transaction] -> Text
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt
where
maybeoriginalamounts :: Transaction -> Transaction
maybeoriginalamounts
| CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"explicit" (CliOpts -> RawOpts
rawopts_ CliOpts
opts) = Transaction -> Transaction
forall a. a -> a
id
| 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_costs = 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
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 :: Text
paccount = Posting -> Text
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 = Text
"_generated-posting" Text -> CsvRecord -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Text, Text) -> Text) -> [(Text, Text)] -> CsvRecord
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Posting -> [(Text, Text)]
ptags Posting
p)
entriesReportAsText :: EntriesReport -> TL.Text
entriesReportAsText :: [Transaction] -> Text
entriesReportAsText = (Transaction -> Text) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> Text
showTransaction
entriesReportAsTextHelper :: (Transaction -> T.Text) -> EntriesReport -> TL.Text
entriesReportAsTextHelper :: (Transaction -> Text) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> Text
showtxn = Builder -> Text
TB.toLazyText (Builder -> Text)
-> ([Transaction] -> Builder) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Builder) -> [Transaction] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Builder
TB.fromText (Text -> Builder)
-> (Transaction -> Text) -> Transaction -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
showtxn)
entriesReportAsBeancount :: EntriesReport -> TL.Text
entriesReportAsBeancount :: [Transaction] -> Text
entriesReportAsBeancount [Transaction]
ts =
Text
opendirectives Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Transaction -> Text) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> Text
showTransactionBeancount [Transaction]
ts
where
opendirectives :: Text
opendirectives
| [Transaction] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts = Text
""
| Bool
otherwise = Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ CsvRecord -> Text
T.unlines [
Text
firstdate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" open " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
accountNameToBeancount Text
a
| Text
a <- CsvRecord -> CsvRecord
forall a. Ord a => [a] -> [a]
nubSort (CsvRecord -> CsvRecord) -> CsvRecord -> CsvRecord
forall a b. (a -> b) -> a -> b
$ (Transaction -> CsvRecord) -> [Transaction] -> CsvRecord
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> Text) -> [Posting] -> CsvRecord
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount([Posting] -> CsvRecord)
-> (Transaction -> [Posting]) -> Transaction -> CsvRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> [Posting]
tpostings) [Transaction]
ts
]
where
firstdate :: Text
firstdate = Day -> Text
showDate (Day -> Text) -> Day -> Text
forall a b. (a -> b) -> a -> b
$ Day -> [Day] -> Day
forall a. Ord a => a -> [a] -> a
minimumDef Day
forall a. a
err ([Day] -> Day) -> [Day] -> Day
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate [Transaction]
ts
where err :: a
err = CommandDoc -> a
forall a. CommandDoc -> a
error' CommandDoc
"entriesReportAsBeancount: should not happen"
entriesReportAsSql :: EntriesReport -> TL.Text
entriesReportAsSql :: [Transaction] -> Text
entriesReportAsSql [Transaction]
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
[ Text -> Builder
TB.fromText Text
"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"
, Text -> Builder
TB.fromText Text
"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 (Text -> Builder
TB.fromText Text
",") ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (CsvRecord -> Builder) -> [CsvRecord] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CsvRecord -> Builder
values [CsvRecord]
csv
, Text -> Builder
TB.fromText Text
";\n"
]
where
values :: CsvRecord -> Builder
values CsvRecord
vs = Text -> Builder
TB.fromText Text
"(" 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 (Text -> Builder
TB.fromText Text
",") ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Text -> Builder) -> CsvRecord -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
toSql CsvRecord
vs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
")\n"
toSql :: Text -> Builder
toSql Text
"" = Text -> Builder
TB.fromText Text
"NULL"
toSql Text
s = Text -> Builder
TB.fromText Text
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText (Text -> Text -> Text -> Text
T.replace Text
"'" Text
"''" Text
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
"'"
csv :: [CsvRecord]
csv = (Transaction -> [CsvRecord]) -> [Transaction] -> [CsvRecord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Transaction -> [CsvRecord]
transactionToCSV (Transaction -> [CsvRecord])
-> (Transaction -> Transaction) -> Transaction -> [CsvRecord]
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=Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.'}}
entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv :: [Transaction] -> [CsvRecord]
entriesReportAsCsv [Transaction]
txns =
[Text
"txnidx",Text
"date",Text
"date2",Text
"status",Text
"code",Text
"description",Text
"comment",Text
"account",Text
"amount",Text
"commodity",Text
"credit",Text
"debit",Text
"posting-status",Text
"posting-comment"] CsvRecord -> [CsvRecord] -> [CsvRecord]
forall a. a -> [a] -> [a]
:
(Transaction -> [CsvRecord]) -> [Transaction] -> [CsvRecord]
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 =
(CsvRecord -> CsvRecord) -> [CsvRecord] -> [CsvRecord]
forall a b. (a -> b) -> [a] -> [b]
map (\CsvRecord
p -> CommandDoc -> Text
T.pack (Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show Integer
idx)Text -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:Text
dText -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:Text
d2Text -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:Text
statusText -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:Text
codeText -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:Text
descriptionText -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:Text
commentText -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:CsvRecord
p)
((Posting -> [CsvRecord]) -> [Posting] -> [CsvRecord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [CsvRecord]
postingToCSV ([Posting] -> [CsvRecord]) -> [Posting] -> [CsvRecord]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t)
where
idx :: Integer
idx = Transaction -> Integer
tindex Transaction
t
description :: Text
description = Transaction -> Text
tdescription Transaction
t
d :: Text
d = Day -> Text
showDate (Transaction -> Day
tdate Transaction
t)
d2 :: Text
d2 = Text -> (Day -> Text) -> Maybe Day -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Day -> Text
showDate (Maybe Day -> Text) -> Maybe Day -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Maybe Day
tdate2 Transaction
t
status :: Text
status = CommandDoc -> Text
T.pack (CommandDoc -> Text) -> (Status -> CommandDoc) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Status -> Text) -> Status -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Status
tstatus Transaction
t
code :: Text
code = Transaction -> Text
tcode Transaction
t
comment :: Text
comment = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcomment Transaction
t
postingToCSV :: Posting -> CSV
postingToCSV :: Posting -> [CsvRecord]
postingToCSV Posting
p =
(Amount -> CsvRecord) -> [Amount] -> [CsvRecord]
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 -> Amount
amountStripCost Amount
a{acommodity :: Text
acommodity=Text
""} in
let showamt :: Amount -> Text
showamt = WideBuilder -> Text
wbToText (WideBuilder -> Text) -> (Amount -> WideBuilder) -> Amount -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
csvDisplay in
let amt :: Text
amt = Amount -> Text
showamt Amount
a_ in
let credit :: Text
credit = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0 then Amount -> Text
showamt (Amount -> Text) -> Amount -> Text
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
a_ else Text
"" in
let debit :: Text
debit = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
>= Quantity
0 then Amount -> Text
showamt Amount
a_ else Text
"" in
[Text
account, Text
amt, Text
c, Text
credit, Text
debit, Text
status, Text
comment])
([Amount] -> [CsvRecord])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [CsvRecord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts (MixedAmount -> [CsvRecord]) -> MixedAmount -> [CsvRecord]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
where
status :: Text
status = CommandDoc -> Text
T.pack (CommandDoc -> Text) -> (Status -> CommandDoc) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Status -> Text) -> Status -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Status
pstatus Posting
p
account :: Text
account = Maybe Int -> PostingType -> Text -> Text
showAccountName Maybe Int
forall a. Maybe a
Nothing (Posting -> PostingType
ptype Posting
p) (Posting -> Text
paccount Posting
p)
comment :: Text
comment = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Text
pcomment Posting
p