cli/Hcompta/CLI/Command/Balance.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE MultiParamTypeClasses #-}
   3 {-# LANGUAGE NamedFieldPuns #-}
   4 {-# LANGUAGE OverloadedStrings #-}
   5 {-# LANGUAGE ScopedTypeVariables #-}
   6 {-# LANGUAGE TupleSections #-}
   7 module Hcompta.CLI.Command.Balance where
   8
   9 import           Control.Applicative ((<*), Const(..))
  10 import           Control.Monad (Monad(..), forM_, liftM, mapM)
  11 import           Control.Monad.IO.Class (liftIO)
  12 import           Control.Monad.Trans.Except (runExceptT)
  13 import           Data.Bool
  14 import           Data.Either (Either(..), partitionEithers)
  15 import           Data.Eq (Eq(..))
  16 import           Data.Foldable (Foldable(..), any)
  17 import           Data.Functor (Functor(..))
  18 import           Data.List ((++), repeat, replicate)
  19 import qualified Data.Map.Strict as Data.Map
  20 import           Data.Maybe (Maybe(..), maybe)
  21 import           Data.Monoid (Monoid(..), (<>))
  22 import           Data.Ord (Ord(..))
  23 import qualified Data.Strict.Maybe as Strict
  24 import           Data.String (String)
  25 import qualified Data.Text.Lazy as TL
  26 import qualified Data.Time.Clock as Time
  27 import           Prelude (($), (.), Bounded(..), FilePath, IO, Num(..), const, id, flip, unlines, zipWith)
  28 import qualified Text.Parsec
  29 import           Text.Show (Show(..))
  30 import           System.Console.GetOpt
  31                  ( ArgDescr(..)
  32                  , OptDescr(..)
  33                  , usageInfo
  34                  )
  35 import           System.Environment as Env (getProgName)
  36 import           System.Exit (exitSuccess)
  37 import qualified System.IO as IO
  38
  39 import           Hcompta.Account (Account)
  40 import qualified Hcompta.Account as Account
  41 import qualified Hcompta.Account.Read as Account.Read
  42 import           Hcompta.Amount (Amount)
  43 import qualified Hcompta.Amount as Amount
  44 import           Hcompta.Amount.Unit (Unit)
  45 import qualified Hcompta.Amount.Write as Amount.Write
  46 import qualified Hcompta.Balance as Balance
  47 import           Hcompta.Chart (Chart)
  48 import qualified Hcompta.Chart as Chart
  49 import qualified Hcompta.CLI.Args as Args
  50 import           Hcompta.CLI.Context (Context)
  51 import qualified Hcompta.CLI.Context as Context
  52 import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger
  53 import qualified Hcompta.CLI.Lang as Lang
  54 import qualified Hcompta.CLI.Lib.Leijen.Table as Table
  55 import qualified Hcompta.CLI.Write as Write
  56 import qualified Hcompta.Date as Date
  57 import qualified Hcompta.Filter as Filter
  58 import qualified Hcompta.Filter.Read as Filter.Read
  59 import qualified Hcompta.Format.Ledger as Ledger
  60 import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
  61 import qualified Hcompta.Format.Ledger.Read as Ledger.Read
  62 import qualified Hcompta.Format.Ledger.Write as Ledger.Write
  63 import           Hcompta.Lib.Leijen (toDoc, ToDoc(..))
  64 import qualified Hcompta.Lib.Leijen as W
  65 import           Hcompta.Lib.TreeMap (TreeMap)
  66 import qualified Hcompta.Lib.TreeMap as TreeMap
  67 import qualified Hcompta.Posting as Posting
  68 import qualified Hcompta.Tag as Tag
  69
  70 data Ctx
  71  =   Ctx
  72  { ctx_filter_balance      :: Filter.Simplified
  73                               (Filter.Filter_Bool
  74                               (Filter.Filter_Balance
  75                               ((Account, Tag.Tags), Amount.Sum Amount)))
  76  , ctx_filter_posting      :: Filter.Simplified
  77                               (Filter.Filter_Bool
  78                               (Filter.Filter_Posting
  79                               (Chart, Ledger.Posting)))
  80  , ctx_filter_transaction  :: Filter.Simplified
  81                               (Filter.Filter_Bool
  82                               (Filter.Filter_Transaction
  83                               (Chart, Ledger.Transaction)))
  84  , ctx_heritage            :: Bool
  85  , ctx_input               :: [FilePath]
  86  , ctx_reduce_date         :: Bool
  87  , ctx_redundant           :: Bool
  88  , ctx_total_by_unit       :: Bool
  89  , ctx_format_output       :: Format_Output
  90  , ctx_account_equilibrium :: Account
  91  } deriving (Show)
  92
  93 data Format_Output
  94  =   Format_Output_Table
  95  |   Format_Output_Transaction { negate_transaction :: Bool }
  96  deriving (Eq, Show)
  97
  98 nil :: Context -> Ctx
  99 nil context =
 100         Ctx
 101          { ctx_filter_balance      = mempty
 102          , ctx_filter_posting      = mempty
 103          , ctx_filter_transaction  = mempty
 104          , ctx_heritage            = True
 105          , ctx_input               = []
 106          , ctx_reduce_date         = True
 107          , ctx_redundant           = False
 108          , ctx_total_by_unit       = True
 109          , ctx_format_output       = Format_Output_Table
 110          , ctx_account_equilibrium = Lang.translate (Context.lang context) Lang.Equilibrium
 111          }
 112
 113 usage :: IO String
 114 usage = do
 115         bin <- Env.getProgName
 116         let pad = replicate (length bin) ' '
 117         return $ unlines $
 118                 [ "SYNTAX "
 119                 , "  "++bin++" balance [-i FILE_JOURNAL]"
 120                 , "  "++pad++"         [-b FILTER_BALANCE]"
 121                 , "  "++pad++"         [-p FILTER_POSTING]"
 122                 , "  "++pad++"         [-t FILTER_TRANSACTION]"
 123                 , "  "++pad++"         [FILE_JOURNAL] [...]"
 124                 , ""
 125                 , usageInfo "OPTIONS" options
 126                 ]
 127
 128 options :: Args.Options Ctx
 129 options =
 130         [ Option "b" ["filter-balance"]
 131          (ReqArg (\s context ctx -> do
 132                 ctx_filter_balance <-
 133                         liftM ((ctx_filter_balance ctx <>) . Filter.simplify) $
 134                                 liftIO $ Filter.Read.read Filter.Read.filter_balance s
 135                                 >>= \f -> case f of
 136                                  Left  ko -> Write.fatal context $ ko
 137                                  Right ok -> return ok
 138                 return $ ctx{ctx_filter_balance}) "FILTER_BALANCE")
 139          "filter at balance level, multiple uses are merged with a logical AND"
 140         , Option "p" ["filter-posting"]
 141          (ReqArg (\s context ctx -> do
 142                 ctx_filter_posting <-
 143                         liftM ((ctx_filter_posting ctx <>) . Filter.simplify) $
 144                         liftIO $ Filter.Read.read Filter.Read.filter_posting s
 145                         >>= \f -> case f of
 146                          Left  ko -> Write.fatal context $ ko
 147                          Right ok -> return ok
 148                 return $ ctx{ctx_filter_posting}) "FILTER_POSTING")
 149          "filter at posting level, multiple uses are merged with a logical AND"
 150         , Option "t" ["filter-transaction"]
 151          (ReqArg (\s context ctx -> do
 152                 ctx_filter_transaction <-
 153                         liftM ((ctx_filter_transaction ctx <>) . Filter.simplify) $
 154                         liftIO $ Filter.Read.read Filter.Read.filter_transaction s
 155                         >>= \f -> case f of
 156                          Left  ko -> Write.fatal context $ ko
 157                          Right ok -> return ok
 158                 return $ ctx{ctx_filter_transaction}) "FILTER_TRANSACTION")
 159          "filter at transaction level, multiple uses are merged with a logical AND"
 160         , Option "h" ["help"]
 161          (NoArg (\_context _ctx -> do
 162                 usage >>= IO.hPutStr IO.stderr
 163                 exitSuccess))
 164          "show this help"
 165         , Option "i" ["input"]
 166          (ReqArg (\s _context ctx -> do
 167                 return $ ctx{ctx_input=s:ctx_input ctx}) "FILE_JOURNAL")
 168          "read data from given file, multiple uses merge the data as would a concatenation do"
 169         {- NOTE: not used so far.
 170         , Option "" ["reduce-date"]
 171          (OptArg (\arg context ctx -> do
 172                 ctx_reduce_date <- case arg of
 173                  Nothing    -> return $ True
 174                  Just "yes" -> return $ True
 175                  Just "no"  -> return $ False
 176                  Just _     -> Write.fatal context $
 177                         W.text "--reduce-date option expects \"yes\", or \"no\" as value"
 178                 return $ ctx{ctx_reduce_date})
 179           "[yes|no]")
 180          "use advanced date reducer to speed up filtering"
 181         -}
 182         , Option "" ["redundant"]
 183          (OptArg (\arg context ctx -> do
 184                 ctx_redundant <- case arg of
 185                  Nothing    -> return $ True
 186                  Just "yes" -> return $ True
 187                  Just "no"  -> return $ False
 188                  Just _     -> Write.fatal context $
 189                         W.text "--redundant option expects \"yes\", or \"no\" as value"
 190                 return $ ctx{ctx_redundant})
 191           "[yes|no]")
 192          "also print accounts with zero amount or the same amounts than its ascending account"
 193         , Option "" ["heritage"]
 194          (OptArg (\arg context ctx -> do
 195                 ctx_heritage <- case arg of
 196                  Nothing    -> return $ True
 197                  Just "yes" -> return $ True
 198                  Just "no"  -> return $ False
 199                  Just _     -> Write.fatal context $
 200                         W.text "--heritage option expects \"yes\", or \"no\" as value"
 201                 return $ ctx{ctx_heritage})
 202           "[yes|no]")
 203          "propagate amounts to ascending accounts"
 204         , Option "" ["total"]
 205          (OptArg (\arg context ctx -> do
 206                 ctx_total_by_unit <- case arg of
 207                  Nothing    -> return $ True
 208                  Just "yes" -> return $ True
 209                  Just "no"  -> return $ False
 210                  Just _     -> Write.fatal context $
 211                         W.text "--total option expects \"yes\", or \"no\" as value"
 212                 return $ ctx{ctx_total_by_unit})
 213           "[yes|no]")
 214          "calculate totals by unit"
 215         , Option "f" ["format"]
 216          (ReqArg (\arg context ctx -> do
 217                 ctx_format_output <- case arg of
 218                  "table" -> return $ Format_Output_Table
 219                  "open"  -> return $ Format_Output_Transaction False
 220                  "close" -> return $ Format_Output_Transaction True
 221                  _       -> Write.fatal context $
 222                         W.text "--format option expects \"close\", \"open\", or \"table\" as value"
 223                 return $ ctx{ctx_format_output})
 224           "[close|open|table]")
 225          "select output format"
 226         , Option "" ["equilibrium"]
 227          (ReqArg (\arg context ctx -> do
 228                 ctx_account_equilibrium <-
 229                         case Text.Parsec.runParser
 230                                  (Account.Read.account <* Text.Parsec.eof)
 231                                  () "" arg of
 232                          Right acct -> return acct
 233                          _          -> Write.fatal context $
 234                                 W.text "--equilibrium option expects a valid account name"
 235                 return $ ctx{ctx_account_equilibrium})
 236           "ACCOUNT")
 237          "specify account equilibrating a close or open balance"
 238         ]
 239
 240 run :: Context.Context -> [String] -> IO ()
 241 run context args = do
 242         (ctx, inputs) <- Args.parse context usage options (nil context, args)
 243         read_journals <-
 244                 liftM Data.Either.partitionEithers $ do
 245                 CLI.Ledger.paths context $ ctx_input ctx ++ inputs
 246                 >>= do
 247                         mapM $ \path -> do
 248                                 liftIO $ runExceptT $ Ledger.Read.file
 249                                  (Ledger.Read.context ( ctx_filter_transaction ctx
 250                                                       , ctx_filter_posting     ctx )
 251                                                       Ledger.journal)
 252                                  path
 253                                 >>= \x -> case x of
 254                                  Left  ko -> return $ Left (path, ko)
 255                                  Right ok -> return $ Right ok
 256         case read_journals of
 257          (errs@(_:_), _journals) ->
 258                 forM_ errs $ \(_path, err) -> do
 259                         Write.fatal context $ err
 260          ([], journals) -> do
 261                 Write.debug context $ "filter: transaction: " ++ show (ctx_filter_transaction ctx)
 262                 Write.debug context $ "filter: posting: " ++ show (ctx_filter_posting ctx)
 263                 Write.debug context $ "filter: balance: " ++ show (ctx_filter_balance ctx)
 264                 style_color <- Write.with_color context IO.stdout
 265                 case ctx_format_output ctx of
 266                  Format_Output_Transaction nt -> do
 267                         let (chart, bal) = ledger_balance_by_account ctx journals
 268                         let balance_by_account = ledger_balance_by_account_filter ctx (chart, bal)
 269                         let Balance.Balance_by_Unit balance_by_unit =
 270                                 ledger_balance_by_unit ctx balance_by_account
 271                         let equilibrium_postings =
 272                                 Data.Map.foldlWithKey
 273                                  (\acc unit bu ->
 274                                         let amt =
 275                                                 (if nt then id else negate) $
 276                                                 Amount.sum_balance $ Balance.unit_sum_amount bu in
 277                                         let acct = equilibrium_account context chart
 278                                                  (if nt then Lang.Exercise_Closing else Lang.Exercise_Opening)
 279                                                  amt in
 280                                         (Ledger.posting acct)
 281                                          { Ledger.posting_amounts  = Data.Map.singleton unit amt
 282                                          , Ledger.posting_comments =
 283                                                  [ Lang.translate (Context.lang context) Lang.Equilibrium_posting ]
 284                                          }:acc
 285                                  )
 286                                  mempty
 287                                  balance_by_unit
 288                         now <- liftM (\d -> d{Time.utctDayTime=0}) $ Date.now
 289                         let transaction =
 290                                 Ledger.transaction
 291                                  { Ledger.transaction_description=
 292                                         TL.toStrict $ W.displayT $ W.renderOneLine False $
 293                                         toDoc (Context.lang context) $
 294                                         Lang.Message_Balance_Description nt
 295                                  , Ledger.transaction_dates=(now, [])
 296                                  , Ledger.transaction_postings=
 297                                         Data.Map.unionWith mappend
 298                                          (Ledger.posting_by_Account equilibrium_postings)
 299                                          (TreeMap.flatten_with_Path
 300                                                  (\posting_account (Balance.Account_Sum amount_by_unit) ->
 301                                                         [(Ledger.posting posting_account)
 302                                                          { Ledger.posting_amounts =
 303                                                                 flip fmap amount_by_unit $
 304                                                                         (if nt then negate else id)
 305                                                                         . Amount.sum_balance
 306                                                          }
 307                                                         ]
 308                                                  )
 309                                                  balance_by_account
 310                                          )
 311                                  }
 312                         let sty = Ledger.Write.Style
 313                                  { Ledger.Write.style_align = True -- ctx_align ctx
 314                                  , Ledger.Write.style_color
 315                                  }
 316                         Ledger.Write.put sty IO.stdout $ do
 317                         Ledger.Write.transaction transaction
 318                  Format_Output_Table -> do
 319                         let ( table_balance_by_account
 320                                   , Balance.Balance_by_Unit balance_by_unit
 321                                   ) =
 322                                 let (ch, bal) = ledger_balance_by_account ctx journals in
 323                                 if ctx_heritage ctx
 324                                 then
 325                                         let balance_filtered = ledger_balance_by_account_expanded ctx ch bal in
 326                                         ( table_by_account ctx Balance.inclusive balance_filtered
 327                                         , ledger_balance_by_unit_expanded ctx    balance_filtered
 328                                         )
 329                                 else
 330                                         let balance_filtered = ledger_balance_by_account_filter ctx (ch, bal) in
 331                                         ( table_by_account       ctx id balance_filtered
 332                                         , ledger_balance_by_unit ctx    balance_filtered
 333                                         )
 334                         W.displayIO IO.stdout $ do
 335                         W.renderPretty style_color 1.0 maxBound $ do
 336                         toDoc () $ do
 337                         let title =
 338                                 TL.toStrict . W.displayT .
 339                                 W.renderCompact False .
 340                                 toDoc (Context.lang context)
 341                         zipWith id
 342                          [ Table.column (title Lang.Message_Debit)   Table.Align_Right
 343                          , Table.column (title Lang.Message_Credit)  Table.Align_Right
 344                          , Table.column (title Lang.Message_Balance) Table.Align_Right
 345                          , Table.column (title Lang.Message_Account) Table.Align_Left
 346                          ] $ do
 347                                 table_balance_by_account $ do
 348                                 case ctx_total_by_unit ctx of
 349                                  False -> repeat []
 350                                  True -> do
 351                                         zipWith (:)
 352                                          [ Table.Cell_Line '=' 0
 353                                          , Table.Cell_Line '=' 0
 354                                          , Table.Cell_Line '=' 0
 355                                          , Table.Cell_Line ' ' 0
 356                                          ] $ do
 357                                         flip table_by_unit (repeat []) $
 358                                                 Data.Map.map
 359                                                  Balance.unit_sum_amount
 360                                                  balance_by_unit
 361
 362 ledger_balance_by_account
 363  :: Ctx
 364  -> [ Ledger.Journal (Const (Balance.Balance_by_Account (Amount.Sum Amount))
 365                             (Chart, Ledger.Transaction)) ]
 366  -> (Chart, Balance.Balance_by_Account (Amount.Sum Amount))
 367 ledger_balance_by_account _ctx =
 368         Data.Foldable.foldl'
 369          (flip (\j ->
 370                 flip mappend $
 371                 (Ledger.journal_chart j,) $
 372                 Ledger.Journal.fold
 373                  (\Ledger.Journal
 374                          { Ledger.journal_sections=Const b
 375                          } -> mappend b
 376                  ) j mempty
 377          ))
 378          mempty
 379
 380 ledger_balance_by_account_filter
 381  :: Ctx
 382  -> (Chart, Balance.Balance_by_Account (Amount.Sum Amount))
 383  -> Balance.Balance_by_Account (Amount.Sum Amount)
 384 ledger_balance_by_account_filter ctx (chart, balance) =
 385         case Filter.simplified $ ctx_filter_balance ctx of
 386          Right True ->
 387                 if ctx_redundant ctx
 388                 then balance
 389                 else TreeMap.filter_with_Path_and_Node (const . is_worth) balance
 390          Right False -> mempty
 391          Left flt ->
 392                 TreeMap.filter_with_Path_and_Node
 393                  (\node acct bal ->
 394                         (is_worth node bal &&) $
 395                         Data.Foldable.any
 396                          (Filter.test flt . ((acct, Chart.account_tags acct chart),)) $
 397                         Balance.get_Account_Sum bal)
 398                  balance
 399         where
 400                 is_worth node bal =
 401                         let _descendants = TreeMap.nodes
 402                                  (TreeMap.node_descendants node) in
 403                         ctx_redundant ctx
 404                         -- NOTE: worth if no descendant
 405                         -- but Account's exclusive
 406                         -- has at least a non-zero Amount
 407                         || Data.Foldable.any
 408                                  (not . Amount.is_zero . Amount.sum_balance)
 409                                  (Balance.get_Account_Sum bal)
 410
 411 ledger_balance_by_account_expanded
 412  :: Ctx
 413  -> Chart
 414  -> Balance.Balance_by_Account (Amount.Sum Amount)
 415  -> Balance.Expanded           (Amount.Sum Amount)
 416 ledger_balance_by_account_expanded ctx chart =
 417         case Filter.simplified $ ctx_filter_balance ctx of
 418          Right True  ->
 419                 if ctx_redundant ctx
 420                 then id
 421                 else TreeMap.filter_with_Path_and_Node (const . is_worth)
 422          Right False -> const mempty
 423          Left flt ->
 424                 TreeMap.filter_with_Path_and_Node
 425                  (\node acct bal ->
 426                         (is_worth node bal &&) $
 427                         Data.Foldable.any
 428                          (Filter.test flt . ((acct, Chart.account_tags acct chart),)) $
 429                                 Balance.get_Account_Sum $
 430                                 Balance.inclusive bal)
 431         . Balance.expanded
 432         where
 433                 is_worth node bal =
 434                         let descendants = TreeMap.nodes
 435                                  (TreeMap.node_descendants node) in
 436                         ctx_redundant ctx
 437                         -- NOTE: worth if no descendant
 438                         -- but Account's inclusive
 439                         -- has at least a non-zero Amount
 440                         || (Data.Map.null descendants
 441                                  && Data.Foldable.any
 442                                          (not . Amount.is_zero . Amount.sum_balance)
 443                                          (Balance.get_Account_Sum $ Balance.inclusive bal))
 444                         -- NOTE: worth if Account's exclusive
 445                         -- has at least a non-zero Amount
 446                         || (Data.Foldable.any
 447                                  (not . Amount.is_zero . Amount.sum_balance)
 448                                  (Balance.get_Account_Sum $ Balance.exclusive bal))
 449                         -- NOTE: worth if Account has at least more than
 450                         -- one descendant Account whose inclusive
 451                         -- has at least a non-zero Amount
 452                         || Data.Map.size
 453                                  ( Data.Map.filter
 454                                          ( Strict.maybe False
 455                                                  ( Data.Foldable.any
 456                                                          (not . Amount.is_zero . Amount.sum_balance)
 457                                                  . Balance.get_Account_Sum
 458                                                  . Balance.inclusive )
 459                                          . TreeMap.node_value )
 460                                          descendants
 461                                  ) > 1
 462
 463 ledger_balance_by_unit
 464  :: Ctx
 465  -> Balance.Balance_by_Account (Amount.Sum Amount)
 466  -> Balance.Balance_by_Unit    (Amount.Sum Amount)
 467 ledger_balance_by_unit _ctx =
 468         flip Balance.by_unit_of_by_account mempty
 469
 470 ledger_balance_by_unit_expanded
 471  :: Ctx
 472  -> Balance.Expanded        (Amount.Sum Amount)
 473  -> Balance.Balance_by_Unit (Amount.Sum Amount)
 474 ledger_balance_by_unit_expanded _ctx =
 475         flip Balance.by_unit_of_expanded mempty
 476
 477 table_by_account
 478  :: Ctx
 479  -> (amount -> Balance.Account_Sum (Amount.Sum Amount))
 480  -> TreeMap Account.Account_Section amount
 481  -> [[Table.Cell]]
 482  -> [[Table.Cell]]
 483 table_by_account _ctx get_Account_Sum =
 484         let posting_type = Posting.Posting_Type_Regular in
 485         flip $ TreeMap.foldr_with_Path
 486          (\account balance rows ->
 487                 foldr
 488                  (\(amount_positive, amount_negative, amount) ->
 489                         zipWith (:)
 490                                 [ Table.cell
 491                                  { Table.cell_content = maybe W.empty Amount.Write.amount  amount_positive
 492                                  , Table.cell_width   = maybe 0 Amount.Write.amount_length amount_positive
 493                                  }
 494                                 , Table.cell
 495                                  { Table.cell_content = maybe W.empty Amount.Write.amount  amount_negative
 496                                  , Table.cell_width   = maybe 0 Amount.Write.amount_length amount_negative
 497                                  }
 498                                 , Table.cell
 499                                  { Table.cell_content = Amount.Write.amount        $ amount
 500                                  , Table.cell_width   = Amount.Write.amount_length $ amount
 501                                  }
 502                                 , Table.cell
 503                                  { Table.cell_content = Ledger.Write.account        posting_type account
 504                                  , Table.cell_width   = Ledger.Write.account_length posting_type account
 505                                  }
 506                                 ]
 507                  )
 508                  rows $
 509                 let bal = Balance.get_Account_Sum $ get_Account_Sum balance in
 510                 Data.Map.foldrWithKey
 511                  (\unit amount acc ->
 512                         ( maybe Nothing Amount.sum_positive $ Data.Map.lookup unit $ bal
 513                         , maybe Nothing Amount.sum_negative $ Data.Map.lookup unit $ bal
 514                         , Amount.sum_balance amount
 515                         ) : acc
 516                  ) [] $ bal
 517          )
 518
 519 table_by_unit
 520  :: Data.Map.Map Unit (Amount.Sum Amount)
 521  -> [[Table.Cell]]
 522  -> [[Table.Cell]]
 523 table_by_unit =
 524         flip $ foldr
 525          (\amount_sum ->
 526                 zipWith (:)
 527                         [ let amt = Amount.sum_positive amount_sum in
 528                                 Table.cell
 529                                  { Table.cell_content = maybe W.empty Amount.Write.amount  amt
 530                                  , Table.cell_width   = maybe 0 Amount.Write.amount_length amt
 531                                  }
 532                         , let amt = Amount.sum_negative amount_sum in
 533                                 Table.cell
 534                                  { Table.cell_content = maybe W.empty Amount.Write.amount  amt
 535                                  , Table.cell_width   = maybe 0 Amount.Write.amount_length amt
 536                                  }
 537                         , let amt = Amount.sum_balance amount_sum in
 538                                 Table.cell
 539                                  { Table.cell_content = Amount.Write.amount        amt
 540                                  , Table.cell_width   = Amount.Write.amount_length amt
 541                                  }
 542                         , Table.cell
 543                                  { Table.cell_content = W.empty
 544                                  , Table.cell_width   = 0
 545                                  }
 546                         ]
 547          )
 548
 549 equilibrium_account :: Context -> Chart -> Lang.Exercise_OC -> Amount -> Account
 550 equilibrium_account context chart oc amt =
 551         let lang = Context.lang context in
 552         let tag = Lang.translate lang (oc, Amount.sign amt) in
 553         case Chart.tag_accounts tag chart of
 554          []  -> Lang.translate lang Lang.Equilibrium
 555          a:_ -> a