{-|

A ledger-compatible @print@ command.

-}

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

module Hledger.Cli.Commands.Print (
  printmode
 ,print'
 -- ,entriesReportAsText
 ,roundFlag
 ,roundFromRawOpts
 ,amountStylesSetRoundingFromRawOpts
 ,transactionWithMostlyOriginalPostings
)
where


import Data.Function ((&))
import Data.List (intersperse, intercalate)
import Data.List.Extra (nubSort)
import Data.Text (Text)
import Data.Map (Map)
import qualified Data.Map as Map
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 Safe (lastMay, minimumDef)
import System.Console.CmdArgs.Explicit

import Hledger
import Hledger.Write.Beancount (accountNameToBeancount, showTransactionBeancount, showBeancountMetadata)
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods)
import Hledger.Write.Html.Lucid (styledTableHtml)
import qualified Hledger.Write.Spreadsheet as Spr
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Cli.Anchor (setAccountAnchor)
import qualified Lucid
import qualified System.IO as IO
import Data.Maybe (isJust, catMaybes, fromMaybe)
import Hledger.Write.Beancount (commodityToBeancount, tagsToBeancountMetadata)

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
"invert"] (String -> RawOpts -> RawOpts
setboolopt String
"invert") String
"display all amounts with reversed sign"
  ,[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] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"base-url"] (\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
"base-url" String
s RawOpts
opts) String
"URLPREFIX" String
"in html output, generate links to hledger-web, with this prefix. (Usually the base url shown by hledger-web; can also be relative.)"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"location"] (String -> RawOpts -> RawOpts
setboolopt String
"location") String
"add file/line number tags to print output"
  ,[String] -> Flag RawOpts
outputFormatFlag [String
"txt",String
"beancount",String
"csv",String
"tsv",String
"html",String
"fods",String
"json",String
"sql"]
  ,Flag RawOpts
outputFileFlag
  ])
  [(String, [Flag RawOpts])]
cligeneralflagsgroups1
  [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 (default)"
  ,String
"soft - just add or remove decimal zeros"
  ,String
"       to match precision"
  ,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 -> Map CommoditySymbol AmountStyle -> Map CommoditySymbol AmountStyle
amountStylesSetRoundingFromRawOpts :: RawOpts -> Map Text AmountStyle -> Map Text AmountStyle
amountStylesSetRoundingFromRawOpts RawOpts
rawopts Map Text AmountStyle
styles =
  case RawOpts -> Maybe Rounding
roundFromRawOpts RawOpts
rawopts of
    Just Rounding
r  -> Rounding -> Map Text AmountStyle -> Map Text AmountStyle
amountStylesSetRounding Rounding
r Map Text AmountStyle
styles
    Maybe Rounding
Nothing -> Map Text AmountStyle
styles

-- | Print journal transactions in standard format.
print' :: CliOpts -> Journal -> IO ()
print' :: CliOpts -> Journal -> IO ()
print' opts :: CliOpts
opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts} 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)
      Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
& if String -> RawOpts -> Bool
boolopt String
"location" RawOpts
rawopts then (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions Transaction -> Transaction
addLocationTag else Journal -> Journal
forall a. a -> a
id

  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 -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
opts Journal
j' (String -> Text -> Text
forall a. Show a => String -> a -> a
dbg1 String
"finding best match for description" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
desc) of
        Just Transaction
t  -> CliOpts -> Journal -> IO ()
printEntries CliOpts
opts Journal
j'{jtxns=[t]}
        Maybe Transaction
Nothing -> String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"no transactions found with descriptions like " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
desc

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 Text AmountStyle
styles = RawOpts -> Map Text AmountStyle -> Map Text AmountStyle
amountStylesSetRoundingFromRawOpts RawOpts
rawopts (Map Text AmountStyle -> Map Text AmountStyle)
-> Map Text AmountStyle -> Map Text AmountStyle
forall a b. (a -> b) -> a -> b
$ Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j

    fmt :: String
fmt = CliOpts -> String
outputFormatFromOpts CliOpts
opts
    baseUrl :: Maybe Text
baseUrl = ReportOpts -> Maybe Text
balance_base_url_ (ReportOpts -> Maybe Text) -> ReportOpts -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
    query :: [Text]
query = ReportOpts -> [Text]
querystring_ (ReportOpts -> [Text]) -> ReportOpts -> [Text]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
    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 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
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"beancount" = Map Text [Tag] -> [Transaction] -> Text
entriesReportAsBeancount (Journal -> Map Text [Tag]
jdeclaredaccounttags Journal
j) ([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
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"csv"       = CSV -> Text
printCSV (CSV -> Text) -> ([Transaction] -> CSV) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> CSV
entriesReportAsCsv ([Transaction] -> CSV)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> CSV
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
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"tsv"       = CSV -> Text
printTSV (CSV -> Text) -> ([Transaction] -> CSV) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transaction] -> CSV
entriesReportAsCsv ([Transaction] -> CSV)
-> ([Transaction] -> [Transaction]) -> [Transaction] -> CSV
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
           | 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 Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text 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 Text AmountStyle -> [Transaction] -> [Transaction]
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"html" =
                (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> ([Transaction] -> Text) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html () -> Text
forall a. Html a -> Text
Lucid.renderText (Html () -> Text)
-> ([Transaction] -> Html ()) -> [Transaction] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Cell NumLines (Html ())]] -> Html ()
forall border. Lines border => [[Cell border (Html ())]] -> Html ()
styledTableHtml ([[Cell NumLines (Html ())]] -> Html ())
-> ([Transaction] -> [[Cell NumLines (Html ())]])
-> [Transaction]
-> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                ([Cell NumLines Text] -> [Cell NumLines (Html ())])
-> [[Cell NumLines Text]] -> [[Cell NumLines (Html ())]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines Text -> Cell NumLines (Html ()))
-> [Cell NumLines Text] -> [Cell NumLines (Html ())]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Html ()) -> Cell NumLines Text -> Cell NumLines (Html ())
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
Lucid.toHtml)) ([[Cell NumLines Text]] -> [[Cell NumLines (Html ())]])
-> ([Transaction] -> [[Cell NumLines Text]])
-> [Transaction]
-> [[Cell NumLines (Html ())]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                AmountFormat
-> Maybe Text -> [Text] -> [Transaction] -> [[Cell NumLines Text]]
entriesReportAsSpreadsheet AmountFormat
oneLineNoCostFmt Maybe Text
baseUrl [Text]
query ([Transaction] -> [[Cell NumLines Text]])
-> ([Transaction] -> [Transaction])
-> [Transaction]
-> [[Cell NumLines 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
           | String
fmtString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"fods" =
                TextEncoding
-> Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text
printFods TextEncoding
IO.localeEncoding (Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text)
-> ([Transaction] -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> [Transaction]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ((Int, Int), [[Cell NumLines Text]])
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall k a. k -> a -> Map k a
Map.singleton Text
"Print" (((Int, Int), [[Cell NumLines Text]])
 -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> ([Transaction] -> ((Int, Int), [[Cell NumLines Text]]))
-> [Transaction]
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (,) (Int
1,Int
0) ([[Cell NumLines Text]] -> ((Int, Int), [[Cell NumLines Text]]))
-> ([Transaction] -> [[Cell NumLines Text]])
-> [Transaction]
-> ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                AmountFormat
-> Maybe Text -> [Text] -> [Transaction] -> [[Cell NumLines Text]]
entriesReportAsSpreadsheet AmountFormat
oneLineNoCostFmt Maybe Text
baseUrl [Text]
query ([Transaction] -> [[Cell NumLines Text]])
-> ([Transaction] -> [Transaction])
-> [Transaction]
-> [[Cell NumLines 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 = 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:
          -- XXX infer_costs is --infer-costs not --show-costs. And where is show-costs used anyway ?
          | 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 = Text
"_generated-posting" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Tag -> Text) -> [Tag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> Text
forall a b. (a, b) -> a
fst (Posting -> [Tag]
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 m a. Monoid m => (a -> m) -> [a] -> m
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)

-- | This generates Beancount-compatible journal output, transforming/encoding the data
-- in various ways when necessary (see Beancount.hs). It renders:
-- account open directives for each account used (on their earliest posting dates),
-- operating_currency directives (based on currencies used in costs),
-- and transaction entries.
-- Transaction and posting tags are converted to metadata lines.
-- Account tags are not propagated to the open directive, currently.
entriesReportAsBeancount ::  Map AccountName [Tag] -> EntriesReport -> TL.Text
entriesReportAsBeancount :: Map Text [Tag] -> [Transaction] -> Text
entriesReportAsBeancount Map Text [Tag]
atags [Transaction]
ts =
  -- PERF: gathers and converts all account names, then repeats that work when showing each transaction
  [Text] -> Text
TL.concat [
     Text -> Text
TL.fromStrict Text
operatingcurrencydirectives
    ,Text -> Text
TL.fromStrict Text
openaccountdirectives
    ,Text
"\n"
    ,(Transaction -> Text) -> [Transaction] -> Text
entriesReportAsTextHelper Transaction -> Text
showTransactionBeancount [Transaction]
ts3
    ]
  where
    -- Remove any virtual postings.
    ts2 :: [Transaction]
ts2 = [Transaction
t{tpostings=filter isReal $ tpostings t} | Transaction
t <- [Transaction]
ts]

    -- Remove any conversion postings that are redundant with costs.
    -- It would be easier to remove the costs instead,
    -- but those are more useful to Beancount than conversion postings.
    ts3 :: [Transaction]
ts3 =
      [ Transaction
t{tpostings=filter (not . isredundantconvp) $ tpostings t}
      | Transaction
t <- [Transaction]
ts2
      -- XXX But conversion-posting tag is on non-redundant postings too, so how to do it ?
      -- Assume the simple case of no more than one cost + conversion posting group in each transaction.
      -- Actually that seems to be required by hledger right now.
      , let isredundantconvp :: Posting -> Bool
isredundantconvp Posting
p =
              Query -> Posting -> Bool
matchesPosting (Regexp -> Maybe Regexp -> Query
Tag (Text -> Regexp
toRegex' Text
"conversion-posting") Maybe Regexp
forall a. Maybe a
Nothing) Posting
p
              Bool -> Bool -> Bool
&& (Posting -> Bool) -> [Posting] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe AmountCost -> Bool
forall a. Maybe a -> Bool
isJust(Maybe AmountCost -> Bool)
-> (Amount -> Maybe AmountCost) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> Maybe AmountCost
acost) ([Amount] -> Bool) -> (Posting -> [Amount]) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) (Transaction -> [Posting]
tpostings Transaction
t)
      ]

    -- https://fava.pythonanywhere.com/example-beancount-file/help/beancount_syntax
    -- https://fava.pythonanywhere.com/example-beancount-file/help/options
    -- "conversion-currencies
    -- When set, the currency conversion select dropdown in all charts will show the list of currencies specified in this option.
    -- By default, Fava lists all operating currencies and those currencies that match ISO 4217 currency codes."

    -- http://furius.ca/beancount/doc/syntax
    -- http://furius.ca/beancount/doc/options
    -- "This option may be supplied multiple times ...
    -- A list of currencies that we single out during reporting and create dedicated columns for ...
    -- we use this to display these values in table cells without their associated unit strings ...
    -- This is used to indicate the main currencies that you work with in real life"
    -- We use: all currencies used in costs.
    operatingcurrencydirectives :: Text
operatingcurrencydirectives
      | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
basecurrencies = Text
""
      | Bool
otherwise = [Text] -> Text
T.unlines ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
todirective (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
commodityToBeancount) [Text]
basecurrencies) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
      where
        todirective :: a -> a
todirective a
c = a
"option \"operating_currency\" \"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""
        basecurrencies :: [Text]
basecurrencies = [Text]
allcostcurrencies
          where
            allcostcurrencies :: [Text]
allcostcurrencies = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Amount -> Text) -> [Amount] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Text
acommodity [Amount]
costamounts
              where
                costamounts :: [Amount]
costamounts =
                  (AmountCost -> Amount) -> [AmountCost] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map (\AmountCost
c -> case AmountCost
c of
                              UnitCost  Amount
a -> Amount
a
                              TotalCost Amount
a -> Amount
a
                              ) ([AmountCost] -> [Amount]) -> [AmountCost] -> [Amount]
forall a b. (a -> b) -> a -> b
$ 
                  [Maybe AmountCost] -> [AmountCost]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe AmountCost] -> [AmountCost])
-> [Maybe AmountCost] -> [AmountCost]
forall a b. (a -> b) -> a -> b
$
                  (Amount -> Maybe AmountCost) -> [Amount] -> [Maybe AmountCost]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Maybe AmountCost
acost ([Amount] -> [Maybe AmountCost]) -> [Amount] -> [Maybe AmountCost]
forall a b. (a -> b) -> a -> b
$
                  (Posting -> [Amount]) -> [Posting] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) ([Posting] -> [Amount]) -> [Posting] -> [Amount]
forall a b. (a -> b) -> a -> b
$
                  (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings
                  [Transaction]
ts3

    -- http://furius.ca/beancount/doc/syntax
    -- "there exists an “Open” directive that is used to provide the start date of each account. 
    -- That can be located anywhere in the file, it does not have to appear in the file somewhere before you use an account name.
    -- You can just start using account names in transactions right away,
    -- though all account names that receive postings to them will eventually have to have
    -- a corresponding Open directive with a date that precedes all transactions posted to the account in the input file."
    openaccountdirectives :: Text
openaccountdirectives
      | [Transaction] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts = Text
""
      | Bool
otherwise = [Text] -> Text
T.unlines [
          Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
            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 -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
            [Text]
mdlines
          | Text
a <- [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Transaction -> [Text]) -> [Transaction] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> Text) -> [Posting] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount([Posting] -> [Text])
-> (Transaction -> [Posting]) -> Transaction -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> [Posting]
tpostings) [Transaction]
ts3
          , let mds :: [Tag]
mds      = [Tag] -> [Tag]
tagsToBeancountMetadata ([Tag] -> [Tag]) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> b
$ [Tag] -> Maybe [Tag] -> [Tag]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Tag] -> [Tag]) -> Maybe [Tag] -> [Tag]
forall a b. (a -> b) -> a -> b
$ Text -> Map Text [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
a Map Text [Tag]
atags
          , let maxwidth :: Int
maxwidth = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Tag -> Int) -> [Tag] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int) -> (Tag -> Text) -> Tag -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text
forall a b. (a, b) -> a
fst) [Tag]
mds
          , let mdlines :: [Text]
mdlines  = (Tag -> Text) -> [Tag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
postingIndent (Text -> Text) -> (Tag -> Text) -> Tag -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Tag -> Text
showBeancountMetadata (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxwidth)) [Tag]
mds
          ]
        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]
ts3
            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
    [ 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
$ ([Text] -> Builder) -> CSV -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Builder
values CSV
csv
    , Text -> Builder
TB.fromText Text
";\n"
    ]
  where
    values :: [Text] -> Builder
values [Text]
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) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
toSql [Text]
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 (HasCallStack => Text -> Text -> Text -> Text
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 :: CSV
csv =
        [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
Spr.rawTableContent ([[Cell NumLines Text]] -> CSV)
-> (Transaction -> [[Cell NumLines Text]]) -> Transaction -> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat
-> Maybe Text -> [Text] -> Transaction -> [[Cell NumLines Text]]
transactionToSpreadsheet AmountFormat
machineFmt Maybe Text
forall a. Maybe a
Nothing [] (Transaction -> [[Cell NumLines Text]])
-> (Transaction -> Transaction)
-> Transaction
-> [[Cell NumLines Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (MixedAmount -> MixedAmount) -> Transaction -> Transaction
transactionMapPostingAmounts ((Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount Amount -> Amount
setDecimalPoint)
            (Transaction -> CSV) -> [Transaction] -> CSV
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Transaction]
txns
      where
        setDecimalPoint :: Amount -> Amount
setDecimalPoint Amount
a = Amount
a{astyle=(astyle a){asdecimalmark=Just '.'}}

entriesReportAsCsv :: EntriesReport -> CSV
entriesReportAsCsv :: [Transaction] -> CSV
entriesReportAsCsv =
  [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
Spr.rawTableContent ([[Cell NumLines Text]] -> CSV)
-> ([Transaction] -> [[Cell NumLines Text]])
-> [Transaction]
-> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat
-> Maybe Text -> [Text] -> [Transaction] -> [[Cell NumLines Text]]
entriesReportAsSpreadsheet AmountFormat
machineFmt Maybe Text
forall a. Maybe a
Nothing []

entriesReportAsSpreadsheet ::
  AmountFormat -> Maybe Text -> [Text] ->
  EntriesReport -> [[Spr.Cell Spr.NumLines Text]]
entriesReportAsSpreadsheet :: AmountFormat
-> Maybe Text -> [Text] -> [Transaction] -> [[Cell NumLines Text]]
entriesReportAsSpreadsheet AmountFormat
fmt Maybe Text
baseUrl [Text]
query [Transaction]
txns =
  [Cell () Text] -> [Cell NumLines Text]
forall text. [Cell () text] -> [Cell NumLines text]
Spr.addHeaderBorders
    ((Text -> Cell () Text) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell
        [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"])
  [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
:
  (Transaction -> [[Cell NumLines Text]])
-> [Transaction] -> [[Cell NumLines Text]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AmountFormat
-> Maybe Text -> [Text] -> Transaction -> [[Cell NumLines Text]]
transactionToSpreadsheet AmountFormat
fmt Maybe Text
baseUrl [Text]
query) [Transaction]
txns

-- | Generate one record per posting, duplicating the common transaction fields.
-- The txnidx field (transaction index) allows postings to be grouped back into transactions.
transactionToSpreadsheet ::
  AmountFormat -> Maybe Text -> [Text] ->
  Transaction -> [[Spr.Cell Spr.NumLines Text]]
transactionToSpreadsheet :: AmountFormat
-> Maybe Text -> [Text] -> Transaction -> [[Cell NumLines Text]]
transactionToSpreadsheet AmountFormat
fmt Maybe Text
baseUrl [Text]
query Transaction
t =
  [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text.
[Cell border text] -> [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader (Cell NumLines Text
idxCell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:Cell NumLines Text
dCell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:Cell NumLines Text
d2Cell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:Cell NumLines Text
statusCell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:Cell NumLines Text
codeCell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:Cell NumLines Text
descriptionCell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:Cell NumLines Text
commentCell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:[])
    (AmountFormat
-> Maybe Text -> [Text] -> Posting -> [[Cell NumLines Text]]
forall border.
Lines border =>
AmountFormat
-> Maybe Text -> [Text] -> Posting -> [[Cell border Text]]
postingToSpreadsheet AmountFormat
fmt Maybe Text
baseUrl [Text]
query (Posting -> [[Cell NumLines Text]])
-> [Posting] -> [[Cell NumLines Text]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Transaction -> [Posting]
tpostings Transaction
t)
  where
    cell :: text -> Cell NumLines text
cell = text -> Cell NumLines text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell
    idx :: Cell NumLines Text
idx = Integer -> Cell NumLines Text
forall border. Lines border => Integer -> Cell border Text
Spr.integerCell (Integer -> Cell NumLines Text) -> Integer -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Integer
tindex Transaction
t
    description :: Cell NumLines Text
description = Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tdescription Transaction
t
    dateCell :: Day -> Cell border Text
dateCell Day
date =
        (Text -> Cell border Text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell (Text -> Cell border Text) -> Text -> Cell border Text
forall a b. (a -> b) -> a -> b
$ Day -> Text
showDate Day
date) {Spr.cellType = Spr.TypeDate}
    d :: Cell NumLines Text
d = Day -> Cell NumLines Text
forall {border}. Lines border => Day -> Cell border Text
dateCell (Day -> Cell NumLines Text) -> Day -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Day
tdate Transaction
t
    d2 :: Cell NumLines Text
d2 = Cell NumLines Text
-> (Day -> Cell NumLines Text) -> Maybe Day -> Cell NumLines Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Cell NumLines Text
forall border text. (Lines border, Monoid text) => Cell border text
Spr.emptyCell Day -> Cell NumLines Text
forall {border}. Lines border => Day -> Cell border Text
dateCell (Maybe Day -> Cell NumLines Text)
-> Maybe Day -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Maybe Day
tdate2 Transaction
t
    status :: Cell NumLines Text
status = Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> (Status -> String) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> String
forall a. Show a => a -> String
show (Status -> Text) -> Status -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Status
tstatus Transaction
t
    code :: Cell NumLines Text
code = Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcode Transaction
t
    comment :: Cell NumLines Text
comment = Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcomment Transaction
t

addRowSpanHeader ::
    [Spr.Cell border text] ->
    [[Spr.Cell border text]] -> [[Spr.Cell border text]]
addRowSpanHeader :: forall border text.
[Cell border text] -> [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader [Cell border text]
common [[Cell border text]]
rows =
    case [[Cell border text]]
rows of
        [] -> []
        [[Cell border text]
row] -> [[Cell border text]
common[Cell border text] -> [Cell border text] -> [Cell border text]
forall a. [a] -> [a] -> [a]
++[Cell border text]
row]
        [[Cell border text]]
_ ->
            let setSpan :: Span -> Cell border text -> Cell border text
setSpan Span
spn Cell border text
cell = Cell border text
cell{Spr.cellSpan = spn} in
            ([Cell border text] -> [Cell border text] -> [Cell border text])
-> [[Cell border text]]
-> [[Cell border text]]
-> [[Cell border text]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Cell border text] -> [Cell border text] -> [Cell border text]
forall a. [a] -> [a] -> [a]
(++)
                ((Cell border text -> Cell border text)
-> [Cell border text] -> [Cell border text]
forall a b. (a -> b) -> [a] -> [b]
map (Span -> Cell border text -> Cell border text
forall {border} {text}.
Span -> Cell border text -> Cell border text
setSpan (Span -> Cell border text -> Cell border text)
-> Span -> Cell border text -> Cell border text
forall a b. (a -> b) -> a -> b
$ Int -> Span
Spr.SpanVertical (Int -> Span) -> Int -> Span
forall a b. (a -> b) -> a -> b
$ [[Cell border text]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Cell border text]]
rows) [Cell border text]
common [Cell border text] -> [[Cell border text]] -> [[Cell border text]]
forall a. a -> [a] -> [a]
:
                 [Cell border text] -> [[Cell border text]]
forall a. a -> [a]
repeat ((Cell border text -> Cell border text)
-> [Cell border text] -> [Cell border text]
forall a b. (a -> b) -> [a] -> [b]
map (Span -> Cell border text -> Cell border text
forall {border} {text}.
Span -> Cell border text -> Cell border text
setSpan Span
Spr.Covered) [Cell border text]
common))
                [[Cell border text]]
rows

postingToSpreadsheet ::
  (Spr.Lines border) =>
  AmountFormat -> Maybe Text -> [Text] ->
  Posting -> [[Spr.Cell border Text]]
postingToSpreadsheet :: forall border.
Lines border =>
AmountFormat
-> Maybe Text -> [Text] -> Posting -> [[Cell border Text]]
postingToSpreadsheet AmountFormat
fmt Maybe Text
baseUrl [Text]
query Posting
p =
  (Amount -> [Cell border Text]) -> [Amount] -> [[Cell border Text]]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Amount
a@(Amount {aquantity :: Amount -> Quantity
aquantity=Quantity
q,acommodity :: Amount -> Text
acommodity=Text
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 credit :: Cell border Text
credit = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0 then Amount -> Cell border Text
forall {border}. Lines border => Amount -> Cell border Text
amountCell (Amount -> Cell border Text) -> Amount -> Cell border Text
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
a_ else Cell border Text
forall border text. (Lines border, Monoid text) => Cell border text
Spr.emptyCell in
    let debit :: Cell border Text
debit  = if Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
>= Quantity
0 then Amount -> Cell border Text
forall {border}. Lines border => Amount -> Cell border Text
amountCell Amount
a_ else Cell border Text
forall border text. (Lines border, Monoid text) => Cell border text
Spr.emptyCell in
    [Maybe Text
-> [Text] -> Text -> Cell border Text -> Cell border Text
forall border text.
Maybe Text
-> [Text] -> Text -> Cell border text -> Cell border text
setAccountAnchor Maybe Text
baseUrl [Text]
query (Posting -> Text
paccount Posting
p) (Cell border Text -> Cell border Text)
-> Cell border Text -> Cell border Text
forall a b. (a -> b) -> a -> b
$ Text -> Cell border Text
forall {text}. text -> Cell border text
cell Text
account,
     Amount -> Cell border Text
forall {border}. Lines border => Amount -> Cell border Text
amountCell Amount
a_, Text -> Cell border Text
forall {text}. text -> Cell border text
cell Text
c,
     Cell border Text
credit, Cell border Text
debit, Text -> Cell border Text
forall {text}. text -> Cell border text
cell Text
status, Text -> Cell border Text
forall {text}. text -> Cell border text
cell Text
comment])
    ([Amount] -> [[Cell border Text]])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [[Cell border Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts (MixedAmount -> [[Cell border Text]])
-> MixedAmount -> [[Cell border Text]]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
  where
    cell :: text -> Cell border text
cell = text -> Cell border text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell
    amountCell :: Amount -> Cell border Text
amountCell Amount
amt =
      AmountFormat -> (Class, (Text, Amount)) -> Cell border Text
forall border wb.
Lines border =>
AmountFormat -> (Class, (wb, Amount)) -> Cell border wb
Spr.cellFromAmount AmountFormat
fmt
        (Text -> Class
Spr.Class Text
"amount", (WideBuilder -> Text
wbToText (WideBuilder -> Text) -> WideBuilder -> Text
forall a b. (a -> b) -> a -> b
$ AmountFormat -> Amount -> WideBuilder
showAmountB AmountFormat
machineFmt Amount
amt, Amount
amt))
    status :: Text
status = String -> Text
T.pack (String -> Text) -> (Status -> String) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> String
forall a. Show a => a -> String
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

addLocationTag :: Transaction -> Transaction
addLocationTag :: Transaction -> Transaction
addLocationTag Transaction
t = Transaction
t{tcomment = tcomment t `commentAddTagNextLine` loctag}
  where
    loctag :: Tag
loctag = (Text
"location", String -> Text
T.pack (String -> Text)
-> ((SourcePos, SourcePos) -> String)
-> (SourcePos, SourcePos)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, SourcePos) -> String
sourcePosPairPretty ((SourcePos, SourcePos) -> Text) -> (SourcePos, SourcePos) -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t)