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

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

import Control.Monad (when)
import Data.Function (on)
import Data.List (groupBy)
import Data.Maybe
import qualified Data.Text as T (pack)
import Data.Time.Calendar
import System.Console.CmdArgs.Explicit as C

import Hledger
import Hledger.Cli.CliOptions

defclosingacct :: [Char]
defclosingacct = "equity:closing balances"
defopeningacct :: [Char]
defopeningacct = "equity:opening balances"

closemode :: Mode RawOpts
closemode = [Char]
-> [Flag RawOpts]
-> [([Char], [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Close.txt")
  [[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone ["closing"] ([Char] -> RawOpts -> RawOpts
setboolopt "closing") "show just closing transaction"
  ,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone ["opening"] ([Char] -> RawOpts -> RawOpts
setboolopt "opening") "show just opening transaction"
  ,[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq  ["close-to"] (\s :: [Char]
s opts :: RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt "close-to" [Char]
s RawOpts
opts) "ACCT" ("account to transfer closing balances to (default: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
defclosingacct[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++")")
  ,[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq  ["open-from"] (\s :: [Char]
s opts :: RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt "open-from" [Char]
s RawOpts
opts) "ACCT" ("account to transfer opening balances from (default: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
defopeningacct[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++")")
  ]
  [([Char], [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ [Char] -> Arg RawOpts
argsFlag "[QUERY]")

close :: CliOpts -> Journal -> IO ()
close CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
  Day
today <- IO Day
getCurrentDay
  let
      (opening :: Bool
opening, closing :: Bool
closing) =
        case ([Char] -> RawOpts -> Bool
boolopt "opening" RawOpts
rawopts, [Char] -> RawOpts -> Bool
boolopt "closing" RawOpts
rawopts) of
          (False, False) -> (Bool
True, Bool
True) -- by default show both opening and closing
          (o :: Bool
o, c :: Bool
c) -> (Bool
o, Bool
c)
      closingacct :: Text
closingacct = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
defclosingacct (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> Maybe [Char]
maybestringopt "close-to" RawOpts
rawopts
      openingacct :: Text
openingacct = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
defopeningacct (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> Maybe [Char]
maybestringopt "open-from" RawOpts
rawopts
      ropts_ :: ReportOpts
ropts_ = ReportOpts
ropts{balancetype_ :: BalanceType
balancetype_=BalanceType
HistoricalBalance, accountlistmode_ :: AccountListMode
accountlistmode_=AccountListMode
ALFlat}
      q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
today ReportOpts
ropts_
      openingdate :: Day
openingdate = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
today (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
q
      closingdate :: Day
closingdate = Integer -> Day -> Day
addDays (-1) Day
openingdate
      (acctbals :: [BalanceReportItem]
acctbals,_) = ReportOpts
-> Query -> Journal -> ([BalanceReportItem], MixedAmount)
balanceReportFromMultiBalanceReport ReportOpts
ropts_ Query
q Journal
j
      balancingamt :: MixedAmount
balancingamt = MixedAmount -> MixedAmount
forall a. Num a => a -> a
negate (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (BalanceReportItem -> MixedAmount)
-> [BalanceReportItem] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (\(_,_,_,b :: MixedAmount
b) -> MixedAmount -> MixedAmount
normaliseMixedAmount MixedAmount
b) [BalanceReportItem]
acctbals

      -- since balance assertion amounts are required to be exact, the
      -- amounts in opening/closing transactions should be too (#941, #1137)
      setprec :: Amount -> Amount
setprec = Amount -> Amount
setFullPrecision
      -- balance assertion amounts will be unpriced (#824)
      -- only the last posting in each commodity will have a balance assertion (#1035)
      closingps :: [Posting]
closingps = [Posting
posting{paccount :: Text
paccount          = Text
a
                          ,pamount :: MixedAmount
pamount           = [Amount] -> MixedAmount
mixed [Amount -> Amount
setprec (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
b]
                          ,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion = if Bool
islast then BalanceAssertion -> Maybe BalanceAssertion
forall a. a -> Maybe a
Just BalanceAssertion
assertion{baamount :: Amount
baamount=Amount -> Amount
setprec Amount
b{aquantity :: Quantity
aquantity=0, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}} else Maybe BalanceAssertion
forall a. Maybe a
Nothing
                          }
                  | (a :: Text
a,_,_,mb :: MixedAmount
mb) <- [BalanceReportItem]
acctbals
                    -- the balances in each commodity, and for each transaction price
                  , let bs :: [Amount]
bs = MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
normaliseMixedAmount MixedAmount
mb
                    -- mark the last balance in each commodity
                  , let bs' :: [(Amount, Bool)]
bs' = [[(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]
bs) (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)
                                     | [Amount]
bs <- (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]
bs]
                  , (b :: Amount
b, islast :: Bool
islast) <- [(Amount, Bool)]
bs'
                  ]
                  -- The balancing posting to equity. Allow this one to have a multicommodity amount,
                  -- and don't try to assert its balance.
                  [Posting] -> [Posting] -> [Posting]
forall a. [a] -> [a] -> [a]
++
                  [Posting
posting{paccount :: Text
paccount = Text
closingacct
                          ,pamount :: MixedAmount
pamount  = MixedAmount -> MixedAmount
forall a. Num a => a -> a
negate MixedAmount
balancingamt
                          }
                  ]

      openingps :: [Posting]
openingps = [Posting
posting{paccount :: Text
paccount          = Text
a
                          ,pamount :: MixedAmount
pamount           = [Amount] -> MixedAmount
mixed [Amount -> Amount
setprec Amount
b]
                          ,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion = case Maybe Amount
mcommoditysum of
                                                 Just s :: Amount
s  -> BalanceAssertion -> Maybe BalanceAssertion
forall a. a -> Maybe a
Just BalanceAssertion
assertion{baamount :: Amount
baamount=Amount -> Amount
setprec Amount
s{aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}}
                                                 Nothing -> Maybe BalanceAssertion
forall a. Maybe a
Nothing
                          }
                  | (a :: Text
a,_,_,mb :: MixedAmount
mb) <- [BalanceReportItem]
acctbals
                    -- the balances in each commodity, and for each transaction price
                  , let bs :: [Amount]
bs = MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
normaliseMixedAmount MixedAmount
mb
                    -- mark the last balance in each commodity, with the unpriced sum in that commodity
                  , let bs' :: [(Amount, Maybe Amount)]
bs' = [[(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]
bs) (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]
bs <- (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]
bs
                                     , let commoditysum :: Amount
commoditysum = ([Amount] -> Amount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
bs)]
                  , (b :: Amount
b, mcommoditysum :: Maybe Amount
mcommoditysum) <- [(Amount, Maybe Amount)]
bs'
                  ]
                  [Posting] -> [Posting] -> [Posting]
forall a. [a] -> [a] -> [a]
++
                  [Posting
posting{paccount :: Text
paccount = Text
openingacct
                          ,pamount :: MixedAmount
pamount  = MixedAmount
balancingamt
                          }
                  ]

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
closing (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> [Char]
showTransaction (Transaction
nulltransaction{tdate :: Day
tdate=Day
closingdate, tdescription :: Text
tdescription="closing balances", tpostings :: [Posting]
tpostings=[Posting]
closingps})
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
opening (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> [Char]
showTransaction (Transaction
nulltransaction{tdate :: Day
tdate=Day
openingdate, tdescription :: Text
tdescription="opening balances", tpostings :: [Posting]
tpostings=[Posting]
openingps})