{-# 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]
++
[[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]")
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)
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
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
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)
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}
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
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
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
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]
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
precise :: Amount -> Amount
precise = Amount -> Amount
amountSetFullPrecision
interleaved :: Bool
interleaved = String -> RawOpts -> Bool
boolopt String
"interleaved" RawOpts
rawopts
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}
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
| 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}
,pbalanceassertion =
if islast
then Just assertion{baamount=precise b}
else Nothing
}
|
(Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
, let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
, 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
,pbalanceassertion =
if islast
then Just assertion{baamount=precise b{aquantity=0, acost=Nothing}}
else Nothing
}
Posting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
: [Posting
posting{paccount=closeacct, pamount=mixedAmount $ precise b} | Bool
interleaved]
|
(Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
, let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
, 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
]
[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]
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}
}
| (Text
a,MixedAmount
mb) <- [(Text, MixedAmount)]
acctbals
, let bs0 :: [Amount]
bs0 = MixedAmount -> [Amount]
amounts MixedAmount
mb
, 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
, 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]
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