{-|

A ledger-compatible @print@ command.

-}

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

module Hledger.Cli.Commands.Print (
  printmode
 ,print'
 -- ,entriesReportAsText
 ,roundFlag
 ,roundFromRawOpts
 ,amountStylesSetRoundingFromRawOpts
 ,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)
import qualified Data.Map as M

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")
  ([[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"
  ,Flag RawOpts
roundFlag
  ,[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"
  ,let arg :: String
arg = String
"DESC" 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
"fuzzy search for one recent transaction with description closest to "String -> String -> String
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
  ([], 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]")

roundFlag :: Flag RawOpts
roundFlag = [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"round"] (\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
"round" String
s RawOpts
opts) String
"TYPE" (String -> Flag RawOpts) -> String -> Flag RawOpts
forall a b. (a -> b) -> a -> b
$
  String -> [String] -> String
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)"
  ]

-- | Get the --round option's value, if any. Can fail with a parse error.
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
. ((String, String) -> Maybe Rounding) -> RawOpts -> [Rounding]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe Rounding
forall {a}. (Eq a, IsString a) => (a, String) -> Maybe Rounding
roundfromrawopt
  where
    roundfromrawopt :: (a, String) -> Maybe Rounding
roundfromrawopt (a
n,String
v)
      | a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
"round", String
vString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"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", String
vString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"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", String
vString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"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", String
vString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"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"            = String -> Maybe Rounding
forall a. String -> a
error' (String -> Maybe Rounding) -> String -> Maybe Rounding
forall a b. (a -> b) -> a -> b
$ String
"--round's value should be none, soft, hard or all; got: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
v
      | Bool
otherwise             = Maybe Rounding
forall a. Maybe a
Nothing

-- | Set these amount styles' rounding strategy when they are being applied to amounts,
-- according to the value of the --round option, if any.
amountStylesSetRoundingFromRawOpts :: RawOpts -> M.Map CommoditySymbol AmountStyle -> M.Map CommoditySymbol AmountStyle
amountStylesSetRoundingFromRawOpts :: RawOpts -> Map CsvValue AmountStyle -> Map CsvValue AmountStyle
amountStylesSetRoundingFromRawOpts RawOpts
rawopts Map CsvValue AmountStyle
styles =
  case RawOpts -> Maybe Rounding
roundFromRawOpts RawOpts
rawopts of
    Just Rounding
r  -> Rounding -> Map CsvValue AmountStyle -> Map CsvValue AmountStyle
amountStylesSetRounding Rounding
r Map CsvValue AmountStyle
styles
    Maybe Rounding
Nothing -> Map CsvValue AmountStyle
styles

-- | 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
    -- lbl = lbl_ "print'"
    j' :: Journal
j' = Journal
j
      -- & dbg9With (lbl "amounts before setting full precision".showJournalAmountsDebug)
      Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
& (MixedAmount -> MixedAmount) -> Journal -> Journal
journalMapPostingAmounts MixedAmount -> MixedAmount
mixedAmountSetFullPrecision
      -- & dbg9With (lbl "amounts after  setting full precision: ".showJournalAmountsDebug)

  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 -> 
      -- 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' (String -> CsvValue -> CsvValue
forall a. Show a => String -> a -> a
dbg1 String
"finding best match for description" (CsvValue -> CsvValue) -> CsvValue -> CsvValue
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=[t]}
        Maybe Transaction
Nothing -> String -> IO ()
putStrLn String
"no matches found." IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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
    -- print does user-specified rounding or (by default) no rounding, in all output formats
    styles :: Map CsvValue AmountStyle
styles = RawOpts -> Map CsvValue AmountStyle -> Map CsvValue AmountStyle
amountStylesSetRoundingFromRawOpts RawOpts
rawopts (Map CsvValue AmountStyle -> Map CsvValue AmountStyle)
-> Map CsvValue AmountStyle -> Map CsvValue AmountStyle
forall a b. (a -> b) -> a -> b
$ Journal -> Map CsvValue AmountStyle
journalCommodityStyles Journal
j

    fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts
    render :: [Transaction] -> Text
render | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"txt"       = [Transaction] -> Text
entriesReportAsText           ([Transaction] -> Text)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CsvValue AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue 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
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"beancount" = [Transaction] -> Text
entriesReportAsBeancount      ([Transaction] -> Text)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CsvValue AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue 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
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"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 CsvValue AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"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 CsvValue AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"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 CsvValue AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"sql"       = [Transaction] -> Text
entriesReportAsSql            ([Transaction] -> Text)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CsvValue AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map CsvValue AmountStyle -> a -> a
styleAmounts Map CsvValue AmountStyle
styles
           | Bool
otherwise        = String -> [Transaction] -> Text
forall a. String -> a
error' (String -> [Transaction] -> Text)
-> String -> [Transaction] -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
unsupportedOutputFormatError String
fmt  -- PARTIAL:
      where
        maybeoriginalamounts :: Transaction -> Transaction
maybeoriginalamounts
          -- Use the fully inferred and amount-styled/rounded transaction in the following situations:
          -- with -x/--explicit:
          | String -> RawOpts -> Bool
boolopt String
"explicit" (CliOpts -> RawOpts
rawopts_ CliOpts
opts) = Transaction -> Transaction
forall a. a -> a
id
          -- with --show-costs:
          | 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
Lens' CliOpts Bool
infer_costs = Transaction -> Transaction
forall a. a -> a
id
          -- with -B/-V/-X/--value ("because of #551, and because of print -V valuing only one posting when there's an implicit txn price.")
          | 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)
Lens' CliOpts (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' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just) CliOpts
opts = Transaction -> Transaction
forall a. a -> a
id
          -- Otherwise, keep the transaction's amounts close to how they were written in the journal.
          | Bool
otherwise = Transaction -> Transaction
transactionWithMostlyOriginalPostings

-- | 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.
-- This is mainly for showing transactions with the amounts in their original journal format.
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 = paccount p
        , pamount = pamount $ if isGenerated then p else orig }
      where
        orig :: Posting
orig = Posting -> Posting
originalPosting Posting
p
        isGenerated :: Bool
isGenerated = CsvValue
"_generated-posting" CsvValue -> CsvRecord -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((CsvValue, CsvValue) -> CsvValue)
-> [(CsvValue, CsvValue)] -> CsvRecord
forall a b. (a -> b) -> [a] -> [b]
map (CsvValue, CsvValue) -> CsvValue
forall a b. (a, b) -> a
fst (Posting -> [(CsvValue, CsvValue)]
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 (Builder -> Text)
-> ([Transaction] -> Builder) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Builder) -> [Transaction] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
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
showtxn)

-- In addition to rendering the transactions in (best effort) Beancount format,
-- this generates an account open directive for each account name used
-- (using the earliest transaction date).
entriesReportAsBeancount :: EntriesReport -> TL.Text
entriesReportAsBeancount :: [Transaction] -> Text
entriesReportAsBeancount [Transaction]
ts =
  -- PERF: gathers and converts all account names, then repeats that work when showing each transaction
  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 -> CsvValue) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> CsvValue
showTransactionBeancount [Transaction]
ts
  where
    opendirectives :: Text
opendirectives
      | [Transaction] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts = Text
""
      | Bool
otherwise = CsvValue -> Text
TL.fromStrict (CsvValue -> Text) -> CsvValue -> Text
forall a b. (a -> b) -> a -> b
$ CsvRecord -> CsvValue
T.unlines [
          CsvValue
firstdate CsvValue -> CsvValue -> CsvValue
forall a. Semigroup a => a -> a -> a
<> CsvValue
" open " CsvValue -> CsvValue -> CsvValue
forall a. Semigroup a => a -> a -> a
<> CsvValue -> CsvValue
accountNameToBeancount CsvValue
a
          | CsvValue
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 -> CsvValue) -> [Posting] -> CsvRecord
forall a b. (a -> b) -> [a] -> [b]
map Posting -> CsvValue
paccount([Posting] -> CsvRecord)
-> (Transaction -> [Posting]) -> Transaction -> CsvRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> [Posting]
tpostings) [Transaction]
ts
          ]
        where
          firstdate :: CsvValue
firstdate = Day -> CsvValue
showDate (Day -> CsvValue) -> Day -> CsvValue
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 = String -> a
forall a. String -> a
error' String
"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
    [ 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
$ (CsvRecord -> Builder) -> [CsvRecord] -> [Builder]
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
"(" 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) -> CsvRecord -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CsvValue -> Builder
toSql CsvRecord
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 (HasCallStack => CsvValue -> CsvValue -> CsvValue -> CsvValue
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 :: [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=(astyle a){asdecimalmark=Just '.'}}

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"] 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

-- | 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 -> [CsvRecord]
transactionToCSV Transaction
t =
  (CsvRecord -> CsvRecord) -> [CsvRecord] -> [CsvRecord]
forall a b. (a -> b) -> [a] -> [b]
map (\CsvRecord
p -> String -> CsvValue
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
idx)CsvValue -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:CsvValue
dCsvValue -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:CsvValue
d2CsvValue -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:CsvValue
statusCsvValue -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:CsvValue
codeCsvValue -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:CsvValue
descriptionCsvValue -> CsvRecord -> CsvRecord
forall a. a -> [a] -> [a]
:CsvValue
commentCsvValue -> 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 :: CsvValue
description = Transaction -> CsvValue
tdescription Transaction
t
    d :: CsvValue
d = Day -> CsvValue
showDate (Transaction -> Day
tdate Transaction
t)
    d2 :: CsvValue
d2 = 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 -> [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 -> 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
amountStripCost Amount
a{acommodity=""} 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
. AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
machineFmt in
    let amt :: CsvValue
amt = 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
amt, CsvValue
c, CsvValue
credit, CsvValue
debit, CsvValue
status, CsvValue
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 :: 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