{-# 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 :: [Char]
defretaindesc = [Char]
"retain earnings"
defclosedesc :: [Char]
defclosedesc = [Char]
"closing balances"
defopendesc :: [Char]
defopendesc = [Char]
"opening balances"
defretainacct :: [Char]
defretainacct = [Char]
"equity:retained earnings"
defcloseacct :: [Char]
defcloseacct = [Char]
"equity:opening/closing 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")
[forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"retain"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"retain") [Char]
"show RX retain earnings transaction"
,forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"migrate"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"migrate") [Char]
"show ALE closing/opening transactions"
,forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"open"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"open") [Char]
"show ALE opening transaction"
,forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"close-desc"] (\[Char]
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"close-desc" [Char]
s RawOpts
opts) [Char]
"DESC" ([Char]
"description for closing transaction (default: "forall a. [a] -> [a] -> [a]
++[Char]
defclosedescforall a. [a] -> [a] -> [a]
++[Char]
")")
,forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"open-desc"] (\[Char]
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"open-desc" [Char]
s RawOpts
opts) [Char]
"DESC" ([Char]
"description for opening transaction (default: "forall a. [a] -> [a] -> [a]
++[Char]
defopendescforall a. [a] -> [a] -> [a]
++[Char]
")")
,forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"close-acct"] (\[Char]
s RawOpts
opts -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"close-acct" [Char]
s RawOpts
opts) [Char]
"ACCT" ([Char]
"account to transfer closing balances to (default: "forall a. [a] -> [a] -> [a]
++[Char]
defcloseacctforall a. [a] -> [a] -> [a]
++[Char]
")")
,forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"explicit",[Char]
"x"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"explicit") [Char]
"show all amounts explicitly"
,forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"interleaved"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"interleaved") [Char]
"keep source and destination postings adjacent"
,forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"show-costs"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"show-costs") [Char]
"keep balances with different costs separate"
]
[([Char], [Flag RawOpts])
generalflagsgroup1]
([Flag RawOpts]
hiddenflags
)
([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char] -> Arg RawOpts
argsFlag [Char]
"[QUERY]")
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_, [Char]
defclosedesc_, [Char]
defopendesc_, [Char]
defcloseacct_, Query
defacctsq_) = if
| [Char] -> RawOpts -> Bool
boolopt [Char]
"retain" RawOpts
rawopts -> (Bool
True, Bool
False, [Char]
defretaindesc, forall a. HasCallStack => a
undefined, [Char]
defretainacct, [AccountType] -> Query
Type [AccountType
Revenue, AccountType
Expense])
| [Char] -> RawOpts -> Bool
boolopt [Char]
"migrate" RawOpts
rawopts -> (Bool
True, Bool
True, [Char]
defclosedesc, [Char]
defopendesc, [Char]
defcloseacct, [AccountType] -> Query
Type [AccountType
Asset, AccountType
Liability, AccountType
Equity])
| [Char] -> RawOpts -> Bool
boolopt [Char]
"open" RawOpts
rawopts -> (Bool
False, Bool
True, forall a. HasCallStack => a
undefined, [Char]
defopendesc, [Char]
defcloseacct, [AccountType] -> Query
Type [AccountType
Asset, AccountType
Liability, AccountType
Equity])
| Bool
otherwise -> (Bool
True, Bool
False, [Char]
defclosedesc, forall a. HasCallStack => a
undefined, [Char]
defcloseacct, Query
Any)
closedesc :: Text
closedesc = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [Char]
defclosedesc_ forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"close-desc" RawOpts
rawopts
opendesc :: Text
opendesc = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [Char]
defopendesc_ forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"open-desc" RawOpts
rawopts
closeacct :: Text
closeacct = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [Char]
defcloseacct_ forall a b. (a -> b) -> a -> b
$ [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"close-acct" RawOpts
rawopts
openacct :: Text
openacct = Text
closeacct
ropts :: ReportOpts
ropts = (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec0){balanceaccum_ :: BalanceAccumulation
balanceaccum_=BalanceAccumulation
Historical, accountlistmode_ :: AccountListMode
accountlistmode_=AccountListMode
ALFlat}
rspec1 :: ReportSpec
rspec1 = ConversionOp -> ReportSpec -> ReportSpec
setDefaultConversionOp ConversionOp
NoConversionOp ReportSpec
rspec0{_rsReportOpts :: ReportOpts
_rsReportOpts=ReportOpts
ropts}
argsq :: Query
argsq = ReportSpec -> Query
_rsQuery ReportSpec
rspec1
yesterday :: Day
yesterday = Integer -> Day -> Day
addDays (-Integer
1) 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 -> 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
argsq
closedate :: Day
closedate = forall a. a -> Maybe a -> a
fromMaybe Day
yesterdayorjournalend Maybe Day
mreportlastday
opendate :: Day
opendate = Integer -> Day -> Day
addDays Integer
1 Day
closedate
explicit :: Bool
explicit = [Char] -> RawOpts -> Bool
boolopt [Char]
"explicit" RawOpts
rawopts Bool -> Bool -> Bool
|| CliOpts
copts forall s a. s -> Getting a s a -> a
^. forall c. HasInputOpts c => Lens' c Bool
infer_costs
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 :: Query
_rsQuery=Query
q2}
([BalanceReportItem]
acctbals',MixedAmount
_) = ReportSpec -> Journal -> ([BalanceReportItem], MixedAmount)
balanceReport ReportSpec
rspec2 Journal
j
acctbals :: [(Text, MixedAmount)]
acctbals = 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 = forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Text, MixedAmount)]
acctbals
precise :: Amount -> Amount
precise = Amount -> Amount
amountSetFullPrecision
interleaved :: Bool
interleaved = [Char] -> RawOpts -> Bool
boolopt [Char]
"interleaved" RawOpts
rawopts
closetxn :: Transaction
closetxn = Transaction
nulltransaction{tdate :: Day
tdate=Day
closedate, tdescription :: Text
tdescription=Text
closedesc, tpostings :: [Posting]
tpostings=[Posting]
closeps}
closeps :: [Posting]
closeps =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
Posting
posting{paccount :: Text
paccount = Text
a
,pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Amount
precise forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Amount
b
,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion =
if Bool
islast
then forall a. a -> Maybe a
Just BalanceAssertion
nullassertion{baamount :: Amount
baamount=Amount -> Amount
precise Amount
b{aquantity :: Quantity
aquantity=Quantity
0, aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}}
else forall a. Maybe a
Nothing
}
forall a. a -> [a] -> [a]
: [Posting
posting{paccount :: Text
paccount=Text
closeacct, pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$ Amount -> Amount
precise Amount
b} | Bool
interleaved]
|
(Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
, let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
, let bs2 :: [(Amount, Bool)]
bs2 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
reverse [Amount]
bs1) (Bool
True forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Bool
False)
| [Amount]
bs1 <- forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> 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
]
forall a. [a] -> [a] -> [a]
++ [Posting
posting{paccount :: Text
paccount=Text
closeacct, pamount :: MixedAmount
pamount=if Bool
explicit then MixedAmount -> MixedAmount
mixedAmountSetFullPrecision MixedAmount
totalamt else MixedAmount
missingmixedamt} | Bool -> Bool
not Bool
interleaved]
opentxn :: Transaction
opentxn = Transaction
nulltransaction{tdate :: Day
tdate=Day
opendate, tdescription :: Text
tdescription=Text
opendesc, tpostings :: [Posting]
tpostings=[Posting]
openps}
openps :: [Posting]
openps =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
Posting
posting{paccount :: Text
paccount = Text
a
,pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$ Amount -> Amount
precise Amount
b
,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion =
case Maybe Amount
mcommoditysum of
Just Amount
s -> forall a. a -> Maybe a
Just BalanceAssertion
nullassertion{baamount :: Amount
baamount=Amount -> Amount
precise Amount
s{aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}}
Maybe Amount
Nothing -> forall a. Maybe a
Nothing
}
forall a. a -> [a] -> [a]
: [Posting
posting{paccount :: Text
paccount=Text
openacct, pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Amount
precise forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Amount
b} | Bool
interleaved]
| (Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
, let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
, let bs2 :: [(Amount, Maybe Amount)]
bs2 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
reverse [Amount]
bs1) (forall a. a -> Maybe a
Just Amount
commoditysum forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat forall a. Maybe a
Nothing)
| [Amount]
bs1 <- forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Amount -> Text
acommodity) [Amount]
bs0
, let commoditysum :: Amount
commoditysum = (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Amount]
bs1)]
, (Amount
b, Maybe Amount
mcommoditysum) <- [(Amount, Maybe Amount)]
bs2
]
forall a. [a] -> [a] -> [a]
++ [Posting
posting{paccount :: Text
paccount=Text
openacct, pamount :: MixedAmount
pamount=if Bool
explicit then MixedAmount -> MixedAmount
mixedAmountSetFullPrecision (MixedAmount -> MixedAmount
maNegate MixedAmount
totalamt) else MixedAmount
missingmixedamt} | Bool -> Bool
not Bool
interleaved]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
close_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStr forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
closetxn
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
open_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStr forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
opentxn