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

module Hledger.Cli.Commands.Close (
  closemode
 ,close
)
where

import Data.Function (on)
import Data.List (groupBy)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time.Calendar (addDays)
import Lens.Micro ((^.))
import System.Console.CmdArgs.Explicit as C

import Hledger
import Hledger.Cli.CliOptions
import Safe (lastDef, readMay, readDef)
import System.FilePath (takeFileName)
import Data.Char (isDigit)
import Hledger.Read.RulesReader (parseBalanceAssertionType)
import Hledger.Cli.Commands.Print (roundFlag, amountStylesSetRoundingFromRawOpts)

defclosedesc :: String
defclosedesc  = String
"closing balances"
defopendesc :: String
defopendesc   = String
"opening balances"
defretaindesc :: String
defretaindesc = String
"retain earnings"

defcloseacct :: String
defcloseacct  = String
"equity:opening/closing balances"
defretainacct :: String
defretainacct = String
"equity:retained earnings"

closemode :: Mode RawOpts
closemode = String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Close.txt")
  [String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String
"migrate"]    (\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
"migrate" String
s RawOpts
opts) String
"NEW" (String
"show closing and opening transactions,"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" for Asset and Liability accounts by default, tagged for easy matching."
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" The tag's default value can be overridden by providing NEW."
    )
  ,String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String
"close"]      (\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
"close" String
s RawOpts
opts)  String
"NEW" String
"(default) show a closing transaction"
  ,String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String
"open"]       (\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
"open" String
s RawOpts
opts)   String
"NEW" String
"show an opening transaction"
  ,String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String
"assign"]     (\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
"assign" String
s RawOpts
opts) String
"NEW" String
"show opening balance assignments"
  ,String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String
"assert"]     (\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
"assert" String
s RawOpts
opts) String
"NEW" String
"show closing balance assertions"
  ,String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String
"retain"]     (\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
"retain" String
s RawOpts
opts) String
"NEW" String
"show a retain earnings transaction, for Revenue and Expense accounts by default"
  ,[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 amounts with different costs separately"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"interleaved"]  (String -> RawOpts -> RawOpts
setboolopt String
"interleaved") String
"show source and destination postings together"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"assertion-type"]  (\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
"assertion-type" String
s RawOpts
opts) String
"TYPE" String
"=, ==, =* or ==*"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"close-desc"]   (\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
"close-desc" String
s RawOpts
opts) String
"DESC" String
"set closing transaction's description"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"close-acct"]   (\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
"close-acct" String
s RawOpts
opts) String
"ACCT" String
"set closing transaction's destination account"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"open-desc"]    (\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
"open-desc"  String
s RawOpts
opts) String
"DESC" String
"set opening transaction's description"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"open-acct"]    (\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
"open-acct"  String
s RawOpts
opts) String
"ACCT" String
"set opening transaction's source account"
  ,Flag RawOpts
roundFlag
  ]
  [(String, [Flag RawOpts])
generalflagsgroup1]
  ([Flag RawOpts]
hiddenflags
    [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++  -- keep supporting old flag names for compatibility
    [[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"closing"]   (String -> RawOpts -> RawOpts
setboolopt String
"close")                                   String
"old spelling of --close"
    ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"opening"]   (String -> RawOpts -> RawOpts
setboolopt String
"open")                                    String
"old spelling of --open"
    ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"close-to"]  (\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
"close-acct" String
s RawOpts
opts) String
"ACCT" String
"old spelling of --close-acct"
    ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"open-from"] (\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
"open-acct"  String
s RawOpts
opts) String
"ACCT" String
"old spelling of --open-acct"
    ]
  )
  ([], 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
"[--migrate|--close|--open|--assign|--assert|--retain] [ACCTQUERY]")

-- | The close command's mode (subcommand).
-- The code depends on these spellings.
data CloseMode = Migrate | Close | Open | Assign | Assert | Retain deriving (CloseMode -> CloseMode -> Bool
(CloseMode -> CloseMode -> Bool)
-> (CloseMode -> CloseMode -> Bool) -> Eq CloseMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloseMode -> CloseMode -> Bool
== :: CloseMode -> CloseMode -> Bool
$c/= :: CloseMode -> CloseMode -> Bool
/= :: CloseMode -> CloseMode -> Bool
Eq,Int -> CloseMode -> String -> String
[CloseMode] -> String -> String
CloseMode -> String
(Int -> CloseMode -> String -> String)
-> (CloseMode -> String)
-> ([CloseMode] -> String -> String)
-> Show CloseMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CloseMode -> String -> String
showsPrec :: Int -> CloseMode -> String -> String
$cshow :: CloseMode -> String
show :: CloseMode -> String
$cshowList :: [CloseMode] -> String -> String
showList :: [CloseMode] -> String -> String
Show,ReadPrec [CloseMode]
ReadPrec CloseMode
Int -> ReadS CloseMode
ReadS [CloseMode]
(Int -> ReadS CloseMode)
-> ReadS [CloseMode]
-> ReadPrec CloseMode
-> ReadPrec [CloseMode]
-> Read CloseMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CloseMode
readsPrec :: Int -> ReadS CloseMode
$creadList :: ReadS [CloseMode]
readList :: ReadS [CloseMode]
$creadPrec :: ReadPrec CloseMode
readPrec :: ReadPrec CloseMode
$creadListPrec :: ReadPrec [CloseMode]
readListPrec :: ReadPrec [CloseMode]
Read)

-- | Pick the rightmost flag spelled like a CloseMode (--migrate, --close, --open, etc), or default to Close.
closeModeFromRawOpts :: RawOpts -> CloseMode
closeModeFromRawOpts :: RawOpts -> CloseMode
closeModeFromRawOpts RawOpts
rawopts = CloseMode -> [CloseMode] -> CloseMode
forall a. a -> [a] -> a
lastDef CloseMode
Close ([CloseMode] -> CloseMode) -> [CloseMode] -> CloseMode
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Maybe CloseMode) -> RawOpts -> [CloseMode]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (\(String
name,String
_) -> String -> Maybe CloseMode
forall a. Read a => String -> Maybe a
readMay (String -> String
capitalise String
name)) RawOpts
rawopts

-- Debugger, beware: close is incredibly devious; simple rules combine to make a horrid maze.
-- Tests are in hledger/test/close.test.
close :: CliOpts -> Journal -> IO ()
close copts :: CliOpts
copts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec0} Journal
j = do
  let
    mode_ :: CloseMode
mode_ = RawOpts -> CloseMode
closeModeFromRawOpts RawOpts
rawopts
    defacctsq_ :: Query
defacctsq_    = if CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Retain then [AccountType] -> Query
Type [AccountType
Revenue, AccountType
Expense] else [AccountType] -> Query
Type [AccountType
Asset, AccountType
Liability]
    defcloseacct_ :: String
defcloseacct_ = if CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Retain then String
defretainacct else String
defcloseacct
    closeacct :: Text
closeacct = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defcloseacct_ (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> Maybe String
maybestringopt String
"close-acct" RawOpts
rawopts
    openacct :: Text
openacct  = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
closeacct String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> Maybe String
maybestringopt String
"open-acct" RawOpts
rawopts

    -- For easy matching and exclusion, a recognisable tag is added to all generated transactions
    tagval :: String
tagval = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> Maybe String
maybestringopt String
modeflag RawOpts
rawopts where modeflag :: String
modeflag = String -> String
lowercase (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CloseMode -> String
forall a. Show a => a -> String
show CloseMode
mode_
    comment :: Text
comment = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ if
      | CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Assert -> String
"assert:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tagval
      | CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Retain -> String
"retain:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tagval
      | Bool
otherwise       -> String
"start:"  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
tagval then String
inferredval else String
tagval
      where
        inferredval :: String
inferredval = String
newfilename
          where
            oldfilename :: String
oldfilename = String -> String
takeFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Journal -> String
journalFilePath Journal
j
            (String
nonnum, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isDigit (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
oldfilename
            (String
oldnum, String
rest2) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rest
            newfilename :: String
newfilename = case String
oldnum of
              [] -> String
""
              String
_  -> String -> String
forall a. [a] -> [a]
reverse String
rest2 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
newnum String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. [a] -> [a]
reverse String
nonnum
                where
                  newnum :: String
newnum = Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> String -> Integer
forall a. Read a => a -> String -> a
readDef Integer
forall {a}. a
err (String -> String
forall a. [a] -> [a]
reverse String
oldnum)  -- PARTIAL: should not fail
                    where err :: a
err = String -> a
forall a. String -> a
error' (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"could not read " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
oldnum String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as a number in Hledger.Cli.Commands.Close.close"

    ropts :: ReportOpts
ropts = (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec0){balanceaccum_=Historical, accountlistmode_=ALFlat}
    rspec1 :: ReportSpec
rspec1 = ConversionOp -> ReportSpec -> ReportSpec
setDefaultConversionOp ConversionOp
NoConversionOp ReportSpec
rspec0{_rsReportOpts=ropts}

    -- Dates of the closing and opening transactions.
    -- "The default closing date is yesterday, or the journal's end date, whichever is later.
    -- You can change this by specifying a [report end date](#report-start--end-date) with `-e`.
    -- The last day of the report period will be the closing date, eg `-e 2024` means "close on 2023-12-31".
    -- The opening date is always the day after the closing date."
    argsq :: Query
argsq = ReportSpec -> Query
_rsQuery ReportSpec
rspec1
    yesterday :: Day
yesterday = Integer -> Day -> Day
addDays (-Integer
1) (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Day
_rsDay ReportSpec
rspec1
    yesterdayorjournalend :: Day
yesterdayorjournalend = case Bool -> Journal -> Maybe Day
journalLastDay Bool
False Journal
j of
      Just Day
journalend -> Day -> Day -> Day
forall a. Ord a => a -> a -> a
max Day
yesterday Day
journalend
      Maybe Day
Nothing         -> Day
yesterday
    mreportlastday :: Maybe Day
mreportlastday = Integer -> Day -> Day
addDays (-Integer
1) (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
argsq
    closedate :: Day
closedate = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
yesterdayorjournalend  Maybe Day
mreportlastday
    opendate :: Day
opendate = Integer -> Day -> Day
addDays Integer
1 Day
closedate

    -- should we show the amount(s) on the equity posting(s) ?
    explicit :: Bool
explicit = String -> RawOpts -> Bool
boolopt String
"explicit" RawOpts
rawopts Bool -> Bool -> Bool
|| CliOpts
copts 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

    -- the accounts to close
    argsacctq :: Query
argsacctq = (Query -> Bool) -> Query -> Query
filterQuery (\Query
q -> Query -> Bool
queryIsAcct Query
q Bool -> Bool -> Bool
|| Query -> Bool
queryIsType Query
q) Query
argsq
    q2 :: Query
q2 = if Query -> Bool
queryIsNull Query
argsacctq then [Query] -> Query
And [Query
argsq, Query
defacctsq_] else Query
argsq
    -- always exclude the balancing equity account
    q3 :: Query
q3 = [Query] -> Query
And [Query
q2, Query -> Query
Not (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ Text -> Regexp
accountNameToAccountOnlyRegex Text
closeacct]
    -- the balances to close
    rspec3 :: ReportSpec
rspec3 = ReportSpec
rspec1{_rsQuery=q3}
    ([BalanceReportItem]
acctbals',MixedAmount
_) = ReportSpec -> Journal -> ([BalanceReportItem], MixedAmount)
balanceReport ReportSpec
rspec3 Journal
j
    acctbals :: [(Text, MixedAmount)]
acctbals = (BalanceReportItem -> (Text, MixedAmount))
-> [BalanceReportItem] -> [(Text, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,Text
_,Int
_,MixedAmount
b) -> (Text
a, if ReportOpts -> Bool
show_costs_ ReportOpts
ropts then MixedAmount
b else MixedAmount -> MixedAmount
mixedAmountStripCosts MixedAmount
b)) [BalanceReportItem]
acctbals'
    totalamt :: MixedAmount
totalamt = [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((Text, MixedAmount) -> MixedAmount)
-> [(Text, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (Text, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd [(Text, MixedAmount)]
acctbals

    -- since balance assertion amounts are required to be exact, the
    -- amounts in opening/closing transactions should be too (#941, #1137)
    precise :: Amount -> Amount
precise = Amount -> Amount
amountSetFullPrecision

    -- interleave equity postings next to the corresponding closing posting, or put them all at the end ?
    interleaved :: Bool
interleaved = String -> RawOpts -> Bool
boolopt String
"interleaved" RawOpts
rawopts

    -- a balance assertion template of the right type
    assertion :: BalanceAssertion
assertion =
      case String -> RawOpts -> Maybe String
maybestringopt String
"assertion-type" RawOpts
rawopts Maybe String
-> (String -> Maybe (Bool, Bool)) -> Maybe (Bool, Bool)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe (Bool, Bool)
parseBalanceAssertionType of
        Maybe (Bool, Bool)
Nothing                 -> BalanceAssertion
nullassertion
        Just (Bool
total, Bool
inclusive) -> BalanceAssertion
nullassertion{batotal=total, bainclusive=inclusive}

    -- the closing (balance-asserting or balance-zeroing) transaction
    mclosetxn :: Maybe Transaction
mclosetxn
      | CloseMode
mode_ CloseMode -> [CloseMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CloseMode
Migrate, CloseMode
Close, CloseMode
Assert, CloseMode
Retain] = Maybe Transaction
forall a. Maybe a
Nothing
      | Bool
otherwise = Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
nulltransaction{
          tdate=closedate, tdescription=closedesc, tcomment=comment, tpostings=closeps
          }
      where
        closedesc :: Text
closedesc = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defclosedesc_ (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> Maybe String
maybestringopt String
"close-desc" RawOpts
rawopts
          where
            defclosedesc_ :: String
defclosedesc_
              | CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Retain = String
defretaindesc
              | CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Assert = String
"assert balances"
              | Bool
otherwise       = String
defclosedesc
        closeps :: [Posting]
closeps
          -- XXX some duplication
          | CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Assert =
            [ Posting
posting{
                  paccount          = a
                  ,pamount           = mixedAmount $ precise b{aquantity=0, acost=Nothing}
                  -- after each commodity's last posting, assert 0 balance (#1035)
                  -- balance assertion amounts are unpriced (#824)
                  ,pbalanceassertion =
                      if islast
                      then Just assertion{baamount=precise b}
                      else Nothing
                  }
              | -- get the balances for each commodity and transaction price
                (Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
              , let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
                -- mark the last balance in each commodity with True
              , let bs2 :: [(Amount, Bool)]
bs2 = [[(Amount, Bool)]] -> [(Amount, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Amount, Bool)] -> [(Amount, Bool)]
forall a. [a] -> [a]
reverse ([(Amount, Bool)] -> [(Amount, Bool)])
-> [(Amount, Bool)] -> [(Amount, Bool)]
forall a b. (a -> b) -> a -> b
$ [Amount] -> [Bool] -> [(Amount, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Amount] -> [Amount]
forall a. [a] -> [a]
reverse [Amount]
bs1) (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)
                                | [Amount]
bs1 <- (Amount -> Amount -> Bool) -> [Amount] -> [[Amount]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Amount -> Text) -> Amount -> Amount -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Amount -> Text
acommodity) [Amount]
bs0]
              , (Amount
b, Bool
islast) <- [(Amount, Bool)]
bs2
            ]

          | Bool
otherwise =
            [[Posting]] -> [Posting]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
              Posting
posting{paccount          = a
                    ,pamount           = mixedAmount . precise $ negate b
                    -- after each commodity's last posting, assert 0 balance (#1035)
                    -- balance assertion amounts are unpriced (#824)
                    ,pbalanceassertion =
                        if islast
                        then Just assertion{baamount=precise b{aquantity=0, acost=Nothing}}
                        else Nothing
                    }

              -- maybe an interleaved posting transferring this balance to equity
              Posting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
: [Posting
posting{paccount=closeacct, pamount=mixedAmount $ precise b} | Bool
interleaved]

              | -- get the balances for each commodity and transaction price
                (Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
              , let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
                -- mark the last balance in each commodity with True
              , let bs2 :: [(Amount, Bool)]
bs2 = [[(Amount, Bool)]] -> [(Amount, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Amount, Bool)] -> [(Amount, Bool)]
forall a. [a] -> [a]
reverse ([(Amount, Bool)] -> [(Amount, Bool)])
-> [(Amount, Bool)] -> [(Amount, Bool)]
forall a b. (a -> b) -> a -> b
$ [Amount] -> [Bool] -> [(Amount, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Amount] -> [Amount]
forall a. [a] -> [a]
reverse [Amount]
bs1) (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)
                                | [Amount]
bs1 <- (Amount -> Amount -> Bool) -> [Amount] -> [[Amount]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Amount -> Text) -> Amount -> Amount -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Amount -> Text
acommodity) [Amount]
bs0]
              , (Amount
b, Bool
islast) <- [(Amount, Bool)]
bs2
            ]

            -- or a final multicommodity posting transferring all balances to equity
            -- (print will show this as multiple single-commodity postings)
            [Posting] -> [Posting] -> [Posting]
forall a. [a] -> [a] -> [a]
++ [Posting
posting{paccount=closeacct, pamount=if explicit then mixedAmountSetFullPrecision totalamt else missingmixedamt} | Bool -> Bool
not Bool
interleaved]

    -- the opening (balance-assigning or balance-unzeroing) transaction
    mopentxn :: Maybe Transaction
mopentxn
      | CloseMode
mode_ CloseMode -> [CloseMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CloseMode
Migrate, CloseMode
Open, CloseMode
Assign] = Maybe Transaction
forall a. Maybe a
Nothing
      | Bool
otherwise = Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
nulltransaction{
          tdate=opendate, tdescription=opendesc, tcomment=comment, tpostings=openps
          }
      where
        opendesc :: Text
opendesc  = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defopendesc  (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> Maybe String
maybestringopt String
"open-desc"  RawOpts
rawopts
        openps :: [Posting]
openps
          | CloseMode
mode_ CloseMode -> CloseMode -> Bool
forall a. Eq a => a -> a -> Bool
== CloseMode
Assign =
            [ Posting
posting{paccount         = a
                    ,pamount           = missingmixedamt
                    ,pbalanceassertion = Just assertion{baamount=b}
                        -- case mcommoditysum of
                        --   Just s  -> Just nullassertion{baamount=precise s}
                        --   Nothing -> Nothing
                    }

              | (Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
              , let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
                -- mark the last balance in each commodity with the unpriced sum in that commodity (for a balance assertion)
              , let bs2 :: [(Amount, Maybe Amount)]
bs2 = [[(Amount, Maybe Amount)]] -> [(Amount, Maybe Amount)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Amount, Maybe Amount)] -> [(Amount, Maybe Amount)]
forall a. [a] -> [a]
reverse ([(Amount, Maybe Amount)] -> [(Amount, Maybe Amount)])
-> [(Amount, Maybe Amount)] -> [(Amount, Maybe Amount)]
forall a b. (a -> b) -> a -> b
$ [Amount] -> [Maybe Amount] -> [(Amount, Maybe Amount)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Amount] -> [Amount]
forall a. [a] -> [a]
reverse [Amount]
bs1) (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
commoditysum Maybe Amount -> [Maybe Amount] -> [Maybe Amount]
forall a. a -> [a] -> [a]
: Maybe Amount -> [Maybe Amount]
forall a. a -> [a]
repeat Maybe Amount
forall a. Maybe a
Nothing)
                                | [Amount]
bs1 <- (Amount -> Amount -> Bool) -> [Amount] -> [[Amount]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Amount -> Text) -> Amount -> Amount -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Amount -> Text
acommodity) [Amount]
bs0
                                , let commoditysum :: Amount
commoditysum = ([Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
bs1)]
              , (Amount
b, Maybe Amount
_mcommoditysum) <- [(Amount, Maybe Amount)]
bs2
            ]
            [Posting] -> [Posting] -> [Posting]
forall a. [a] -> [a] -> [a]
++ [Posting
posting{paccount=openacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | Bool -> Bool
not Bool
interleaved]

          | Bool
otherwise =
            [[Posting]] -> [Posting]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
              Posting
posting{paccount          = a
                    ,pamount           = mixedAmount $ precise b
                    ,pbalanceassertion =
                        case mcommoditysum of
                          Just Amount
s  -> BalanceAssertion -> Maybe BalanceAssertion
forall a. a -> Maybe a
Just BalanceAssertion
assertion{baamount=precise s{acost=Nothing}}
                          Maybe Amount
Nothing -> Maybe BalanceAssertion
forall a. Maybe a
Nothing
                    }
              Posting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
: [Posting
posting{paccount=openacct, pamount=mixedAmount . precise $ negate b} | Bool
interleaved]

              | (Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
              , let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
                -- mark the last balance in each commodity with the unpriced sum in that commodity (for a balance assertion)
              , let bs2 :: [(Amount, Maybe Amount)]
bs2 = [[(Amount, Maybe Amount)]] -> [(Amount, Maybe Amount)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Amount, Maybe Amount)] -> [(Amount, Maybe Amount)]
forall a. [a] -> [a]
reverse ([(Amount, Maybe Amount)] -> [(Amount, Maybe Amount)])
-> [(Amount, Maybe Amount)] -> [(Amount, Maybe Amount)]
forall a b. (a -> b) -> a -> b
$ [Amount] -> [Maybe Amount] -> [(Amount, Maybe Amount)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Amount] -> [Amount]
forall a. [a] -> [a]
reverse [Amount]
bs1) (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
commoditysum Maybe Amount -> [Maybe Amount] -> [Maybe Amount]
forall a. a -> [a] -> [a]
: Maybe Amount -> [Maybe Amount]
forall a. a -> [a]
repeat Maybe Amount
forall a. Maybe a
Nothing)
                                | [Amount]
bs1 <- (Amount -> Amount -> Bool) -> [Amount] -> [[Amount]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (Amount -> Text) -> Amount -> Amount -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Amount -> Text
acommodity) [Amount]
bs0
                                , let commoditysum :: Amount
commoditysum = ([Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
bs1)]
              , (Amount
b, Maybe Amount
mcommoditysum) <- [(Amount, Maybe Amount)]
bs2
            ]
            [Posting] -> [Posting] -> [Posting]
forall a. [a] -> [a] -> [a]
++ [Posting
posting{paccount=openacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | Bool -> Bool
not Bool
interleaved]

  -- print them
  -- allow user-specified rounding with --round, like print
  let 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
  IO () -> (Transaction -> IO ()) -> Maybe Transaction -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Text -> IO ()
T.putStr (Text -> IO ()) -> (Transaction -> Text) -> Transaction -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
showTransaction (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) Maybe Transaction
mclosetxn
  IO () -> (Transaction -> IO ()) -> Maybe Transaction -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Text -> IO ()
T.putStr (Text -> IO ()) -> (Transaction -> Text) -> Transaction -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
showTransaction (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) Maybe Transaction
mopentxn