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

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

import Control.Monad (when)
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

defretaindesc :: String
defretaindesc = String
"retain earnings"
defclosedesc :: String
defclosedesc  = String
"closing balances"
defopendesc :: String
defopendesc   = String
"opening balances"
defretainacct :: String
defretainacct = String
"equity:retained earnings"
defcloseacct :: String
defcloseacct  = String
"equity:opening/closing balances"

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] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"close"]        (String -> RawOpts -> RawOpts
setboolopt String
"close")   String
"show a closing transaction (default)"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"open"]         (String -> RawOpts -> RawOpts
setboolopt String
"open")    String
"show an opening transaction"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"migrate"]      (String -> RawOpts -> RawOpts
setboolopt String
"migrate") String
"show both closing and opening transactions"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"retain"]       (String -> RawOpts -> RawOpts
setboolopt String
"retain")  String
"show a retain earnings transaction (for RX accounts)"
  ,[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
"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"
  ]
  [(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
"[--close | --open | --migrate | --retain] [ACCTQUERY]")

-- Debugger, beware: close is incredibly devious; simple rules combine to make a horrid maze.
-- Tests are in hledger/test/close.test.
-- This code is also used by the close command.
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
    (Bool
close_, Bool
open_, String
defclosedesc_, String
defopendesc_, String
defcloseacct_, Query
defacctsq_) = if
      | String -> RawOpts -> Bool
boolopt String
"retain"  RawOpts
rawopts -> (Bool
True,  Bool
False, String
defretaindesc, String
forall a. HasCallStack => a
undefined,   String
defretainacct, [AccountType] -> Query
Type [AccountType
Revenue, AccountType
Expense])
      | String -> RawOpts -> Bool
boolopt String
"migrate" RawOpts
rawopts -> (Bool
True,  Bool
True,  String
defclosedesc,  String
defopendesc, String
defcloseacct,  [AccountType] -> Query
Type [AccountType
Asset, AccountType
Liability, AccountType
Equity])
      | String -> RawOpts -> Bool
boolopt String
"open"    RawOpts
rawopts -> (Bool
False, Bool
True,  String
forall a. HasCallStack => a
undefined,     String
defopendesc, String
defcloseacct,  [AccountType] -> Query
Type [AccountType
Asset, AccountType
Liability, AccountType
Equity])
      | Bool
otherwise                 -> (Bool
True,  Bool
False, String
defclosedesc,  String
forall a. HasCallStack => a
undefined,   String
defcloseacct,  [AccountType] -> Query
Type [AccountType
Asset, AccountType
Liability, AccountType
Equity])

    -- descriptions to use for the closing/opening transactions
    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
    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

    -- equity/balancing accounts to use
    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

    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 balances 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
    rspec2 :: ReportSpec
rspec2 = ReportSpec
rspec1{_rsQuery=q2}
    ([BalanceReportItem]
acctbals',MixedAmount
_) = ReportSpec -> Journal -> ([BalanceReportItem], MixedAmount)
balanceReport ReportSpec
rspec2 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
mixedAmountStripPrices 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

    -- the closing transaction
    closetxn :: Transaction
closetxn = Transaction
nulltransaction{tdate=closedate, tdescription=closedesc, tpostings=closeps}
    closeps :: [Posting]
closeps =
      [[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 nullassertion{baamount=precise b{aquantity=0, aprice=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 transaction
    opentxn :: Transaction
opentxn = Transaction
nulltransaction{tdate=opendate, tdescription=opendesc, tpostings=openps}
    openps :: [Posting]
openps =
      [[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
nullassertion{baamount=precise s{aprice=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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
close_ (IO () -> IO ()) -> (Text -> IO ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
closetxn
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
open_  (IO () -> IO ()) -> (Text -> IO ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
opentxn