cli/Hcompta/CLI/Command/Balance.hs

   1 {-# LANGUAGE ExistentialQuantification #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE NamedFieldPuns #-}
   6 {-# LANGUAGE OverloadedStrings #-}
   7 {-# LANGUAGE Rank2Types #-}
   8 {-# LANGUAGE RecordWildCards #-}
   9 {-# LANGUAGE ScopedTypeVariables #-}
  10 {-# LANGUAGE TupleSections #-}
  11 {-# LANGUAGE TypeFamilies #-}
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13 module Hcompta.CLI.Command.Balance where
  14
  15 import           Control.Applicative ((<*), Const(..), Applicative(..))
  16 import           Control.Arrow (first, (+++), (&&&), (***))
  17 import           Control.DeepSeq (NFData)
  18 import           Control.Monad (Monad(..), liftM, mapM)
  19 import           Control.Monad.IO.Class (liftIO)
  20 import           Data.Bool
  21 import           Data.Data
  22 import           Data.Decimal (Decimal)
  23 import           Data.Either (Either(..), partitionEithers)
  24 import           Data.Eq (Eq(..))
  25 import           Data.Foldable (Foldable)
  26 import qualified Data.Foldable as Foldable
  27 import           Data.Function (($), (.), const, on)
  28 import           Data.Functor (Functor(..), (<$>))
  29 import qualified Data.List as List
  30 -- import           Data.List.NonEmpty (NonEmpty(..))
  31 import           Data.Map.Strict (Map)
  32 import qualified Data.Map.Strict as Map
  33 import           Data.Maybe (Maybe(..))
  34 import           Data.Monoid (Monoid(..), (<>))
  35 import           Data.Ord (Ord(..), Ordering(..))
  36 import qualified Data.Strict.Maybe as Strict
  37 import           Data.String (String)
  38 import           Data.Text (Text)
  39 import qualified Data.Time.Clock as Time
  40 import           Data.TreeMap.Strict (TreeMap)
  41 import qualified Data.TreeMap.Strict as TreeMap
  42 import           Data.Tuple (fst, snd)
  43 import           Prelude (Bounded(..), Num(..), unlines, zipWith)
  44 import           Data.Function (id, flip)
  45 import           System.Console.GetOpt
  46                  ( ArgDescr(..)
  47                  , OptDescr(..)
  48                  , usageInfo
  49                  )
  50 import qualified System.Environment as Env
  51 import           System.Exit (exitSuccess)
  52 import           System.IO (IO, FilePath)
  53 import qualified System.IO as IO
  54 import qualified Text.Parsec
  55 import           Text.Show (Show(..))
  56 import           Text.WalderLeijen.ANSI.Text (ToDoc(..))
  57 import qualified Text.WalderLeijen.ANSI.Text as W
  58
  59 import qualified Hcompta as H
  60 import qualified Hcompta.Lib.Strict as Strict
  61
  62 import qualified Hcompta.CLI.Args as Args
  63 import qualified Hcompta.CLI.Context as C
  64 import qualified Hcompta.CLI.Env as CLI.Env
  65 import           Hcompta.CLI.Format (Format(..), Formats)
  66 import qualified Hcompta.CLI.Format as Format
  67 import           Hcompta.CLI.Format.JCC ()
  68 import           Hcompta.CLI.Format.Ledger ()
  69 import qualified Hcompta.CLI.Lang as Lang
  70 import qualified Hcompta.CLI.Lib.Leijen.Table as Leijen.Table
  71 import qualified Hcompta.CLI.Write as Write
  72 import qualified Hcompta.JCC as JCC
  73 import qualified Hcompta.Ledger as Ledger
  74
  75 import qualified Text.Parsec.Error.Custom as R
  76
  77 -- type Sum = (Ledger.Unit, H.Polarized Ledger.Quantity)
  78
  79 data Context
  80  =   Context
  81  { {-ctx_filter_transaction :: forall t.
  82                              ( Filter.Transaction t
  83                              , Filter.Amount_Quantity
  84                                (Posting.Posting_Amount
  85                                (Filter.Transaction_Posting t))
  86                                ~ Filter.Amount.Quantity
  87                              ) => Filter.Simplified
  88                                   (Filter.Filter_Bool
  89                                   (Filter.Filter_Transaction t))
  90  , ctx_filter_balance     :: forall b.
  91                              ( Filter.Balance b
  92                              , Filter.Amount_Quantity
  93                                (Filter.Balance_Amount b)
  94                                ~ Filter.Amount.Quantity
  95                              ) => Filter.Simplified
  96                                   (Filter.Filter_Bool
  97                                   (Filter.Filter_Balance b))
  98  -- , ctx_filter_posting      :: CLI.Format.Filter_Posting
  99  ,-} ctx_heritage            :: Bool
 100  , ctx_input               :: [FilePath]
 101  , ctx_input_format        :: Formats
 102  , ctx_output              :: [(Write.Mode, FilePath)]
 103  , ctx_output_format       :: (Maybe Formats, Output_Format)
 104  , ctx_reduce_date         :: Bool
 105  , ctx_redundant           :: Bool
 106  , ctx_total_by_unit       :: Bool
 107  , ctx_account_equilibrium :: (JCC.Account, JCC.Account)
 108  } -- deriving (Show)
 109
 110 data Output_Format
 111  =   Output_Format_Table
 112  |   Output_Format_Transaction Lang.Exercise_OC
 113  deriving (Eq, Show)
 114
 115 context :: C.Context -> Context
 116 context c =
 117         Context
 118          { -- ctx_filter_transaction  = Filter.Simplified $ Right True
 119          -- , ctx_filter_balance      = Filter.Simplified $ Right True
 120          -- , ctx_filter_posting      = mempty
 121            ctx_heritage            = True
 122          , ctx_input               = []
 123          , ctx_input_format        = mempty
 124          , ctx_output              = []
 125          , ctx_output_format       = (Nothing, Output_Format_Table)
 126          , ctx_reduce_date         = True
 127          , ctx_redundant           = False
 128          , ctx_total_by_unit       = True
 129          , ctx_account_equilibrium =
 130                 let e = C.translate c Lang.Account_Equilibrium
 131                 in (e, e)
 132          }
 133
 134 usage :: C.Context -> IO String
 135 usage c = do
 136         bin <- Env.getProgName
 137         return $ unlines $
 138                 [ C.translate c Lang.Section_Description
 139                 , "  "<>C.translate c Lang.Help_Command_Balance
 140                 , ""
 141                 , C.translate c Lang.Section_Syntax
 142                 , "  "<>bin<>" balance ["<>C.translate c Lang.Type_Option<>"] [...]"<>
 143                                      " ["<>C.translate c Lang.Type_File_Journal<>"] [...]"
 144                 , ""
 145                 , usageInfo (C.translate c Lang.Section_Options) (options c)
 146                 ]
 147
 148 options :: C.Context -> Args.Options Context
 149 options c =
 150         [ {-Option "b" ["filter-balance"]
 151          (ReqArg (\s ctx -> do
 152                 filter <-
 153                         R.runParserT_with_Error
 154                          Filter.Read.filter_balance
 155                          Filter.Read.context "" s
 156                 case filter of
 157                  Left (ko::[R.Error Filter.Read.Error]) -> Write.fatal c ko
 158                  Right flt ->
 159                         return $
 160                                 ctx{ctx_filter_balance =
 161                                         Filter.and (ctx_filter_balance ctx) $
 162                                         (Filter.simplify $
 163                                                 Filter.Read.get_Forall_Filter_Balance_Decimal <$> flt)
 164                                  }) $
 165                 C.translate c Lang.Type_Filter_Balance) $
 166                 C.translate c Lang.Help_Option_Filter_Balance
 167          -}
 168         {-, Option "p" ["filter-posting"]
 169          (ReqArg (\s ctx -> do
 170                 read <- liftIO $ Filter.Read.read Filter.Read.filter_posting s
 171                 case read of
 172                  Left ko -> Write.fatal c ko
 173                  Right filter -> return $
 174                         ctx{ctx_filter_posting =
 175                                 (ctx_filter_posting ctx <>) $
 176                                 CLI.Format.All
 177                                  (Filter.simplify $ Filter.Read.get_Forall_Filter_Posting_Decimal <$> filter)
 178                                  (Filter.simplify $ Filter.Read.get_Forall_Filter_Posting_Decimal <$> filter)
 179                          }) $
 180                 C.translate c Lang.Type_Filter_Posting) $
 181                 C.translate c Lang.Help_Option_Filter_Posting
 182         -}
 183         {-, Option "t" ["filter-transaction"]
 184          (ReqArg (\s ctx -> do
 185                 filter <-
 186                         R.runParserT_with_Error
 187                          Filter.Read.filter_transaction
 188                          Filter.Read.context "" s
 189                 case filter of
 190                  Left ko -> Write.fatal c ko
 191                  Right flt ->
 192                         return $
 193                                 ctx{ctx_filter_transaction =
 194                                         Filter.and (ctx_filter_transaction ctx) $
 195                                         (Filter.simplify $
 196                                                 Filter.Read.get_Forall_Filter_Transaction_Decimal <$> flt)
 197                                  }) $
 198                 C.translate c Lang.Type_Filter_Transaction) $
 199                 C.translate c Lang.Help_Option_Filter_Transaction
 200         ,-} Option "h" ["help"]
 201          (NoArg (\_ctx -> do
 202                 usage c >>= IO.hPutStr IO.stderr
 203                 exitSuccess)) $
 204                 C.translate c Lang.Help_Option_Help
 205         , Option "i" ["input"]
 206          (ReqArg (\s ctx -> do
 207                 return $ ctx{ctx_input=s:ctx_input ctx}) $
 208                 C.translate c Lang.Type_File_Journal) $
 209                 C.translate c Lang.Help_Option_Input
 210         , Option "f" ["input-format"]
 211          (OptArg (\arg ctx -> do
 212                 ctx_input_format <- case arg of
 213                  Nothing       -> return $ Format_JCC ()
 214                  Just "jcc"    -> return $ Format_JCC ()
 215                  Just "ledger" -> return $ Format_Ledger ()
 216                  Just _        -> Write.fatal c $
 217                         W.text "--input-format option expects \"jcc\", or \"ledger\" as value"
 218                 return $ ctx{ctx_input_format})
 219           "[jcc|ledger]")
 220           "input format"
 221         , Option "o" ["output"]
 222          (ReqArg (\s ctx -> do
 223                 return $ ctx{ctx_output=(Write.Mode_Append, s):ctx_output ctx}) $
 224                 C.translate c Lang.Type_File) $
 225                 C.translate c Lang.Help_Option_Output
 226         , Option "O" ["overwrite"]
 227          (ReqArg (\s ctx -> do
 228                 return $ ctx{ctx_output=(Write.Mode_Over, s):ctx_output ctx}) $
 229                 C.translate c Lang.Type_File) $
 230                 C.translate c Lang.Help_Option_Overwrite
 231         {- NOTE: not used so far.
 232         , Option "" ["reduce-date"]
 233          (OptArg (\arg ctx -> do
 234                 ctx_reduce_date <- case arg of
 235                  Nothing    -> return $ True
 236                  Just "yes" -> return $ True
 237                  Just "no"  -> return $ False
 238                  Just _     -> Write.fatal c $
 239                         W.text "--reduce-date option expects \"yes\", or \"no\" as value"
 240                 return $ ctx{ctx_reduce_date})
 241           "[yes|no]")
 242          "use advanced date reducer to speed up filtering"
 243         -}
 244         , Option "" ["redundant"]
 245          (OptArg (\arg ctx -> do
 246                 ctx_redundant <- case arg of
 247                  Nothing    -> return $ True
 248                  Just "yes" -> return $ True
 249                  Just "no"  -> return $ False
 250                  Just _     -> Write.fatal c Lang.Error_Option_Balance_Redundant
 251                 return $ ctx{ctx_redundant})
 252           "[no|yes]") $
 253                 C.translate c Lang.Help_Option_Balance_Redundant
 254         , Option "" ["heritage"]
 255          (OptArg (\arg ctx -> do
 256                 ctx_heritage <- case arg of
 257                  Nothing    -> return $ True
 258                  Just "yes" -> return $ True
 259                  Just "no"  -> return $ False
 260                  Just _     -> Write.fatal c Lang.Error_Option_Balance_Heritage
 261                 return $ ctx{ctx_heritage})
 262           "[yes|no]") $
 263                 C.translate c Lang.Help_Option_Balance_Heritage
 264         , Option "" ["total"]
 265          (OptArg (\arg ctx -> do
 266                 ctx_total_by_unit <- case arg of
 267                  Nothing    -> return $ True
 268                  Just "yes" -> return $ True
 269                  Just "no"  -> return $ False
 270                  Just _     -> Write.fatal c Lang.Error_Option_Balance_Total
 271                 return $ ctx{ctx_total_by_unit})
 272           "[yes|no]") $
 273                 C.translate c Lang.Help_Option_Balance_Total
 274         , Option "F" ["output-format"]
 275          (ReqArg (\arg ctx -> do
 276                 ctx_output_format <- case arg of
 277                  "table"        -> return $ (Nothing                , Output_Format_Table)
 278                  "table.jcc"    -> return $ (Just $ Format_JCC    (), Output_Format_Table)
 279                  "table.ledger" -> return $ (Just $ Format_Ledger (), Output_Format_Table)
 280                  "open"         -> return $ (Nothing                , Output_Format_Transaction Lang.Exercise_Opening)
 281                  "open.jcc"     -> return $ (Just $ Format_JCC    (), Output_Format_Transaction Lang.Exercise_Opening)
 282                  "open.ledger"  -> return $ (Just $ Format_Ledger (), Output_Format_Transaction Lang.Exercise_Opening)
 283                  "close"        -> return $ (Nothing                , Output_Format_Transaction Lang.Exercise_Closing)
 284                  "close.jcc"    -> return $ (Just $ Format_JCC    (), Output_Format_Transaction Lang.Exercise_Closing)
 285                  "close.ledger" -> return $ (Just $ Format_Ledger (), Output_Format_Transaction Lang.Exercise_Closing)
 286                  _              -> Write.fatal c Lang.Error_Option_Balance_Format
 287                 return $ ctx{ctx_output_format})
 288           "[table|close|open][.jcc|.ledger]") $
 289                 C.translate c Lang.Help_Option_Balance_Format
 290         , Option "" ["eq"]
 291          (ReqArg (\arg ctx -> do
 292                 ctx_account_equilibrium <-
 293                         fmap (\e -> (e, e)) $
 294                         case Text.Parsec.runParser
 295                                  (Ledger.read_account <* Text.Parsec.eof)
 296                                  () "" arg of
 297                          Right acct -> return acct
 298                          _          -> Write.fatal c Lang.Error_Option_Equilibrium
 299                 return $ ctx{ctx_account_equilibrium}) $
 300                 C.translate c Lang.Type_Account) $
 301                 C.translate c Lang.Help_Option_Equilibrium
 302         , Option "" ["eq-credit"]
 303          (ReqArg (\arg ctx -> do
 304                 ctx_account_equilibrium <-
 305                         fmap (\e -> (fst $ ctx_account_equilibrium ctx, e)) $
 306                         case Text.Parsec.runParser
 307                                  (Ledger.read_account <* Text.Parsec.eof)
 308                                  () "" arg of
 309                          Right acct -> return acct
 310                          _          -> Write.fatal c Lang.Error_Option_Equilibrium_Credit
 311                 return $ ctx{ctx_account_equilibrium}) $
 312                 C.translate c Lang.Type_Account) $
 313                 C.translate c Lang.Help_Option_Equilibrium_Credit
 314         , Option "" ["eq-debit"]
 315          (ReqArg (\arg ctx -> do
 316                 ctx_account_equilibrium <-
 317                         fmap (\e -> (e, snd $ ctx_account_equilibrium ctx)) $
 318                         case Text.Parsec.runParser
 319                                  (Ledger.read_account <* Text.Parsec.eof)
 320                                  () "" arg of
 321                          Right acct -> return acct
 322                          _          -> Write.fatal c Lang.Error_Option_Equilibrium_Debit
 323                 return $ ctx{ctx_account_equilibrium}) $
 324                 C.translate c Lang.Type_Account) $
 325                 C.translate c Lang.Help_Option_Equilibrium_Debit
 326         ]
 327
 328 run :: C.Context -> [String] -> IO ()
 329 run c args = do
 330         (ctx, inputs) <-
 331                 first (\x ->
 332                         case ctx_output x of
 333                          [] -> x{ctx_output=[(Write.Mode_Append, "-")]}
 334                          _  -> x) <$>
 335                 Args.parse c usage options (context c, args)
 336         input_paths <- CLI.Env.paths c $ ctx_input ctx <> inputs
 337         read_journals <- mapM (liftIO . journal_read ctx) input_paths
 338         case partitionEithers read_journals of
 339          (errs@(_:_), _journals) -> Write.fatals c errs
 340          ([], (journals::[Forall_Journal_Balance_by_Account])) -> do
 341                 let bal_by_account =
 342                         mconcat $
 343                         fmap Format.journal_flatten $
 344                         case fst $ ctx_output_format ctx of
 345                          Just f -> Format.journal_empty f:journals
 346                          Nothing -> journals
 347                 now <- H.date_epoch
 348                 with_color <- Write.with_color c IO.stdout
 349                 W.displayIO IO.stdout $
 350                         W.renderPretty with_color 1.0 maxBound $
 351                         case snd $ ctx_output_format ctx of
 352                          Output_Format_Table ->
 353                                 toDoc () $ Leijen.Table.table_of (c, ctx) bal_by_account
 354                          Output_Format_Transaction oc ->
 355                                 journal_equilibrium_transaction
 356                                  (Const bal_by_account::Const Forall_Journal_Balance_by_Account ())
 357                                  c ctx oc now
 358                 {-
 359                 Write.debug c $ "filter: transaction: " ++ show (ctx_filter_transaction ctx)
 360                 Write.debug c $ "filter: posting: " ++ show (ctx_filter_posting ctx)
 361                 Write.debug c $ "filter: balance: " ++ show (ctx_filter_balance ctx)
 362                 let sty = Write.style { Write.style_pretty = True }
 363                 -}
 364
 365 instance Leijen.Table.Table_of (C.Context, Context) Forall_Journal_Balance_by_Account where
 366         table_of (c, ctx) bal_by_account =
 367                 let lang = C.lang c in
 368                 let (rows_by_account, rows_by_unit) =
 369                         case ctx_heritage ctx of
 370                          True  -> rows_of_balance_by_account $ expand bal_by_account
 371                          False -> rows_of_balance_by_account          bal_by_account in
 372                 zipWith id
 373                  [ Leijen.Table.column (Lang.translate lang Lang.Title_Debit)   Leijen.Table.Align_Right
 374                  , Leijen.Table.column (Lang.translate lang Lang.Title_Credit)  Leijen.Table.Align_Right
 375                  , Leijen.Table.column (Lang.translate lang Lang.Title_Balance) Leijen.Table.Align_Right
 376                  , Leijen.Table.column (Lang.translate lang Lang.Title_Account) Leijen.Table.Align_Left
 377                  ] $
 378                 rows_by_account $
 379                 (if ctx_total_by_unit ctx
 380                  then zipWith (:)
 381                          [ Leijen.Table.Cell_Line '=' 0
 382                          , Leijen.Table.Cell_Line '=' 0
 383                          , Leijen.Table.Cell_Line '=' 0
 384                          , Leijen.Table.Cell_Line ' ' 0
 385                          ] . rows_by_unit
 386                  else id) $
 387                 List.repeat []
 388                 where
 389                         expand
 390                          :: Forall_Journal_Balance_by_Account
 391                          -> Forall_Journal_Balance_by_Account_Expanded
 392                         expand = Format.journal_wrap
 393                         rows_of_balance_by_account
 394                          :: ( Format.Journal_Filter Context (Const bal_by_account) ()
 395                             , Format.Journal_Wrap bal_by_account Forall_Journal_Balance_by_Unit
 396                             , Format.Journal_Leijen_Table_Cells (Const bal_by_account) ()
 397                             )
 398                          => bal_by_account
 399                          -> ( [[Leijen.Table.Cell]] -> [[Leijen.Table.Cell]]
 400                             , [[Leijen.Table.Cell]] -> [[Leijen.Table.Cell]] )
 401                         rows_of_balance_by_account =
 402                                 (***) Format.journal_leijen_table_cells
 403                                       Format.journal_leijen_table_cells .
 404                                 (&&&) id sum_by_unit .
 405                                 Format.journal_filter ctx .
 406                                 Const
 407                                 where
 408                                         sum_by_unit
 409                                          :: Format.Journal_Wrap bal_by_account Forall_Journal_Balance_by_Unit
 410                                          => Const bal_by_account ()
 411                                          -> Const Forall_Journal_Balance_by_Unit ()
 412                                         sum_by_unit = Const . Format.journal_wrap . getConst
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423 -- * 'H.Balance_by_Account'
 424
 425 -- ** Type 'Format_Balance_by_Account'
 426
 427 type Format_Journal_Balance_by_Account
 428  = Format
 429    (   JCC.Journal Balance_by_Account_JCC)
 430    (Ledger.Journal Balance_by_Account_Ledger)
 431
 432 -- JCC
 433 type Balance_by_Account_JCC
 434  = H.Balance_by_Account JCC.Account_Section
 435                         JCC.Unit
 436                         (H.Polarized JCC.Quantity)
 437 instance Format.Journal (JCC.Journal Balance_by_Account_JCC) where
 438         type Journal_Format   (JCC.Journal Balance_by_Account_JCC)
 439          = Format_Journal_Balance_by_Account
 440         journal_format = Format_JCC
 441
 442 -- Ledger
 443 type Balance_by_Account_Ledger
 444  = H.Balance_by_Account Ledger.Account_Section
 445                         Ledger.Unit
 446                         (H.Polarized Ledger.Quantity)
 447 instance Format.Journal (Ledger.Journal Balance_by_Account_Ledger) where
 448         type Journal_Format   (Ledger.Journal Balance_by_Account_Ledger)
 449          = Format_Journal_Balance_by_Account
 450         journal_format = Format_Ledger
 451
 452 -- ** Class 'Journal_Balance_by_Account'
 453
 454 class
 455  ( Format.Journal (j m)
 456  , Format.Journal_Format (j m) ~ Format_Journal_Balance_by_Account
 457  , Format.Journal_Read j
 458  , Format.Journal_Monoid (j m)
 459  , Format.Journal_Leijen_Table_Cells j m
 460  , Format.Journal_Wrap (j m) Forall_Journal_Balance_by_Account_Expanded
 461  , Format.Journal_Wrap (j m) Forall_Journal_Balance_by_Unit
 462  , Format.Journal_Filter Context j m
 463  , Journal_Equilibrium_Transaction j m
 464  ) => Journal_Balance_by_Account j m
 465
 466 instance Journal_Balance_by_Account    JCC.Journal Balance_by_Account_JCC
 467 instance Journal_Balance_by_Account Ledger.Journal Balance_by_Account_Ledger
 468
 469 -- ** Type 'Forall_Journal_Balance_by_Account'
 470
 471 data    Forall_Journal_Balance_by_Account
 472  = forall j m. Journal_Balance_by_Account  j m
 473  =>     Forall_Journal_Balance_by_Account (j m)
 474
 475 instance Format.Journal Forall_Journal_Balance_by_Account where
 476         type Journal_Format   Forall_Journal_Balance_by_Account = Format_Journal_Balance_by_Account
 477         journal_format
 478          (Forall_Journal_Balance_by_Account j) =
 479                 Format.journal_format j
 480 instance Format.Journal_Empty Forall_Journal_Balance_by_Account where
 481         journal_empty f =
 482                 case f of
 483                  Format_JCC    () -> Forall_Journal_Balance_by_Account (mempty::JCC.Journal Balance_by_Account_JCC)
 484                  Format_Ledger () -> Forall_Journal_Balance_by_Account (mempty::Ledger.Journal Balance_by_Account_Ledger)
 485 instance Format.Journal_Monoid Forall_Journal_Balance_by_Account where
 486         journal_flatten
 487          (Forall_Journal_Balance_by_Account j) =
 488                 Forall_Journal_Balance_by_Account $
 489                 Format.journal_flatten j
 490         journal_fold f (Forall_Journal_Balance_by_Account j) =
 491                 Format.journal_fold (f . Forall_Journal_Balance_by_Account) j
 492 instance Monoid Forall_Journal_Balance_by_Account where
 493         mempty = Forall_Journal_Balance_by_Account (mempty::JCC.Journal Balance_by_Account_JCC)
 494         mappend x y =
 495                 case (mappend `on` Format.journal_format) x y of
 496                  Format_JCC    j -> Forall_Journal_Balance_by_Account j
 497                  Format_Ledger j -> Forall_Journal_Balance_by_Account j
 498         mconcat js =
 499                 case js of
 500                  [] -> mempty
 501                  j:jn -> List.foldl' mappend j jn
 502
 503 -- ** 'journal_read'
 504
 505 type Journal_Filter_Simplified transaction
 506  = Filter.Simplified
 507    (Filter.Filter_Bool
 508    (Filter.Filter_Transaction transaction))
 509 type Journal_Read_Cons txn
 510  = txn -> Filter.Filtered (Journal_Filter_Simplified txn) txn
 511 journal_read
 512  :: Context -> FilePath
 513  -> IO (Either (Format.Message W.Doc) Forall_Journal_Balance_by_Account)
 514 journal_read ctx =
 515         case ctx_input_format ctx of
 516          Format_JCC () ->
 517                 let wrap (j::JCC.Journal Balance_by_Account_JCC)
 518                          = Forall_Journal_Balance_by_Account j in
 519                 let cons :: Journal_Read_Cons (JCC.Charted JCC.Transaction)
 520                          = Filter.Filtered (ctx_filter_transaction ctx) in
 521                 liftM ((+++) Format.Message wrap) .
 522                 Format.journal_read cons
 523          Format_Ledger () ->
 524                 let wrap (j::Ledger.Journal Balance_by_Account_Ledger)
 525                          = Forall_Journal_Balance_by_Account j in
 526                 let cons :: Journal_Read_Cons (Ledger.Charted Ledger.Transaction)
 527                          = Filter.Filtered (ctx_filter_transaction ctx) in
 528                 liftM ((+++) Format.Message wrap) .
 529                 Format.journal_read cons
 530
 531 {-
 532 -- ** Type family 'Balance_by_Account'
 533
 534 type family Balance_by_Account (j:: * -> *) m
 535 type instance Balance_by_Account
 536    j (Balance.Expanded           as u (Polarized q))
 537  = j (Balance.Balance_by_Account as u (Polarized q))
 538 type instance Balance_by_Account
 539    (Const Forall_Journal_Balance_by_Account_Expanded) ()
 540  = (Const Forall_Journal_Balance_by_Account         ) ()
 541 -}
 542
 543 -- Instances 'Format.Journal_Filter'
 544
 545 instance
 546  ( Functor j
 547  , Format.Journal_Chart j
 548
 549  , as ~ Format.Journal_Account_Section j
 550  , Data as
 551  {-, Filter.Account (Account_Tags, TreeMap.Path as)-}
 552  , NFData as
 553  , Ord as
 554  , Show as
 555
 556  , q ~ Format.Journal_Quantity j
 557  , Format.Journal_Quantity j ~ Decimal
 558  , H.Addable q
 559  , H.Zero q
 560
 561  , H.Unit u
 562  ) => Format.Journal_Filter Context j (H.Balance_by_Account as u (H.Polarized q)) where
 563         journal_filter ctx j =
 564                 case Filter.simplified $ ctx_filter_balance ctx of
 565                  Right True | ctx_redundant ctx -> j
 566                  Right True ->
 567                         TreeMap.filter_with_Path_and_Node
 568                          (\n _p -> is_worth n) <$> j
 569                  Right False -> const mempty <$> j
 570                  Left flt ->
 571                         (<$> j) $
 572                         TreeMap.map_Maybe_with_Path_and_Node
 573                          (\node account (H.Balance_by_Account_Sum bal) ->
 574                                 (if is_worth node bal then id else const Strict.Nothing) $
 575                                 case Map.mapMaybeWithKey
 576                                  (\unit qty ->
 577                                         if Filter.test flt
 578                                                  ( (H.chart_account_tags account (Format.journal_chart j), account)
 579                                                  , (unit, qty)
 580                                                  )
 581                                         then Just qty
 582                                         else Nothing
 583                                  ) bal of
 584                                  m | Map.null m -> Strict.Nothing
 585                                  m -> Strict.Just $ H.Balance_by_Account_Sum m
 586                          )
 587                 where
 588                         is_worth
 589                          :: (Ord k0, Foldable t0, H.Addable a0, H.Zero a0)
 590                          => TreeMap.Node k0 x0
 591                          -> t0 (H.Polarized a0)
 592                          -> Bool
 593                         is_worth _node bal =
 594                                 ctx_redundant ctx
 595                                 -- NOTE: worth if no descendant
 596                                 -- but Account's exclusive
 597                                 -- has at least a non-zero Amount
 598                                 || Foldable.any
 599                                          (not . H.quantity_null . H.depolarize)
 600                                          bal
 601 instance Format.Journal_Filter Context (Const Forall_Journal_Balance_by_Account) () where
 602         journal_filter ctx
 603          (Const (Forall_Journal_Balance_by_Account j)) =
 604                 Const $ Forall_Journal_Balance_by_Account $
 605                 Format.journal_filter ctx j
 606
 607 -- Instances 'Format.Journal_Leijen_Table_Cells'
 608
 609 instance
 610  ( Format.Journal_Content j
 611  , Journal j
 612
 613  , as ~ Format.Journal_Account_Section j
 614  , Ord as
 615  , H.Addable (Format.Journal_Quantity j)
 616
 617  , Leijen.Table.Cell_of_forall_param j (TreeMap.Path as)
 618
 619  , Balance_by_Account_Sum amt
 620  , Balance_by_Account_Sum_Unit amt ~ Format.Journal_Unit j
 621  , Balance_by_Account_Sum_Quantity amt ~ H.Polarized (Format.Journal_Quantity j)
 622  ) => Format.Journal_Leijen_Table_Cells j (TreeMap as amt) where
 623         journal_leijen_table_cells jnl =
 624                 flip (TreeMap.foldr_with_Path
 625                  (\account balance rows ->
 626                         let H.Balance_by_Account_Sum bal = balance_by_account_sum balance in
 627                         Map.foldrWithKey
 628                          (\unit qty ->
 629                                 zipWith (:)
 630                                  [ cell_of $ (unit,) <$> H.polarized_positive qty
 631                                  , cell_of $ (unit,) <$> H.polarized_negative qty
 632                                  , cell_of (unit, H.depolarize qty)
 633                                  , cell_of account
 634                                  ]
 635                          )
 636                          rows bal
 637                  ))
 638                  (Format.journal_content jnl)
 639                 where
 640                         cell_of :: Leijen.Table.Cell_of_forall_param j x => x -> Leijen.Table.Cell
 641                         cell_of = Leijen.Table.cell_of_forall_param jnl
 642 instance Format.Journal_Leijen_Table_Cells (Const Forall_Journal_Balance_by_Account) () where
 643         journal_leijen_table_cells
 644          (Const (Forall_Journal_Balance_by_Account j)) =
 645                 Format.journal_leijen_table_cells j
 646
 647 -- ** Class 'Balance_by_Account_Sum'
 648
 649 -- | A class to get a 'H.Balance_Account_Sum'
 650 --   when operating on 'H.Balance_by_Account'
 651 --   or 'H.Balance_Expanded' 'Strict.inclusive' field.
 652 class Balance_by_Account_Sum amt where
 653         type Balance_by_Account_Sum_Unit     amt
 654         type Balance_by_Account_Sum_Quantity amt
 655         balance_by_account_sum
 656          :: amt -> H.Balance_by_Account_Sum (Balance_by_Account_Sum_Unit amt)
 657                                             (Balance_by_Account_Sum_Quantity amt)
 658 instance Balance_by_Account_Sum (H.Balance_by_Account_Sum u q) where
 659         type Balance_by_Account_Sum_Unit     (H.Balance_by_Account_Sum u q) = u
 660         type Balance_by_Account_Sum_Quantity (H.Balance_by_Account_Sum u q) = q
 661         balance_by_account_sum = id
 662 instance Balance_by_Account_Sum (H.Balance_by_Account_Sum_Expanded u q) where
 663         type Balance_by_Account_Sum_Unit     (H.Balance_by_Account_Sum_Expanded u q) = u
 664         type Balance_by_Account_Sum_Quantity (H.Balance_by_Account_Sum_Expanded u q) = q
 665         balance_by_account_sum = Strict.inclusive
 666
 667 -- * 'H.Balance_Expanded'
 668
 669 -- ** Type 'Format_Journal_Balance_by_Account_Expanded'
 670
 671 type Format_Journal_Balance_by_Account_Expanded
 672  = Format
 673    (   JCC.Journal Balance_by_Account_Expanded_JCC)
 674    (Ledger.Journal Balance_by_Account_Expanded_Ledger)
 675
 676 -- JCC
 677 type Balance_by_Account_Expanded_JCC
 678  = H.Balance_Expanded JCC.Account_Section
 679                     JCC.Unit
 680                     (H.Polarized JCC.Quantity)
 681 instance Format.Journal (JCC.Journal Balance_by_Account_Expanded_JCC) where
 682         type Journal_Format   (JCC.Journal Balance_by_Account_Expanded_JCC)
 683          = Format_Journal_Balance_by_Account_Expanded
 684         journal_format = Format_JCC
 685
 686 -- Ledger
 687 type Balance_by_Account_Expanded_Ledger
 688  = H.Balance_Expanded Ledger.Account_Section
 689                       Ledger.Unit
 690                       (H.Polarized Ledger.Quantity)
 691 instance Format.Journal (Ledger.Journal Balance_by_Account_Expanded_Ledger) where
 692         type Journal_Format   (Ledger.Journal Balance_by_Account_Expanded_Ledger)
 693          = Format_Journal_Balance_by_Account_Expanded
 694         journal_format = Format_Ledger
 695
 696 -- ** Class 'Journal_Balance_by_Account_Expanded'
 697
 698 class
 699  ( Format.Journal (j m)
 700  , Format.Journal_Format (j m) ~ Format_Journal_Balance_by_Account_Expanded
 701  , Format.Journal_Leijen_Table_Cells j m
 702  , Format.Journal_Wrap (j m) Forall_Journal_Balance_by_Unit
 703  , Format.Journal_Filter Context j m
 704  ) => Journal_Balance_by_Account_Expanded j m
 705
 706 instance Journal_Balance_by_Account_Expanded    JCC.Journal Balance_by_Account_Expanded_JCC
 707 instance Journal_Balance_by_Account_Expanded Ledger.Journal Balance_by_Account_Expanded_Ledger
 708
 709 -- ** Type 'Forall_Journal_Balance_by_Account_Expanded'
 710
 711 data    Forall_Journal_Balance_by_Account_Expanded
 712  = forall j m. Journal_Balance_by_Account_Expanded  j m
 713  =>     Forall_Journal_Balance_by_Account_Expanded (j m)
 714
 715 instance Format.Journal Forall_Journal_Balance_by_Account_Expanded where
 716         type Journal_Format   Forall_Journal_Balance_by_Account_Expanded = Format_Journal_Balance_by_Account_Expanded
 717         journal_format
 718          (Forall_Journal_Balance_by_Account_Expanded j) =
 719                 Format.journal_format j
 720
 721 -- Instances 'Format.Journal_Filter'
 722
 723 instance
 724  ( Functor j
 725  , Format.Journal_Chart j
 726  , as ~ Format.Journal_Account_Section j
 727  , Data as
 728  {-, Filter.Account (Account_Tags, TreeMap.Path as)-}
 729  , NFData as
 730  , Ord as
 731  , Show as
 732  , q ~ Format.Journal_Quantity j
 733  , Format.Journal_Quantity j ~ Decimal
 734  , H.Addable q
 735  , H.Zero q
 736  , H.Unit u
 737  ) => Format.Journal_Filter Context j (H.Balance_Expanded as u (H.Polarized q)) where
 738         journal_filter ctx j =
 739                 case Filter.simplified $ ctx_filter_balance ctx of
 740                  Right True | ctx_redundant ctx -> j
 741                  Right True ->
 742                         TreeMap.filter_with_Path_and_Node
 743                          (const . is_worth) <$> j
 744                  Right False -> const mempty <$> j
 745                  Left flt ->
 746                         (<$> j) $
 747                         TreeMap.map_Maybe_with_Path_and_Node
 748                          (\node account bal ->
 749                                 (if is_worth node bal then id else const Strict.Nothing) $
 750                                 case Map.mapMaybeWithKey
 751                                  (\unit qty ->
 752                                         if Filter.test flt
 753                                                  ( (H.chart_account_tags account (Format.journal_chart j), account)
 754                                                  , (unit, qty)
 755                                                  )
 756                                         then Just qty
 757                                         else Nothing
 758                                  ) (H.unBalance_by_Account_Sum $ Strict.inclusive bal) of
 759                                  m | Map.null m -> Strict.Nothing
 760                                  m -> Strict.Just $ bal{Strict.inclusive=H.Balance_by_Account_Sum m}
 761                          )
 762                 where
 763                         is_worth node bal =
 764                                 let descendants = TreeMap.nodes
 765                                          (TreeMap.node_descendants node) in
 766                                 ctx_redundant ctx
 767                                 -- NOTE: worth if no descendant
 768                                 -- but Account's inclusive
 769                                 -- has at least a non-zero Amount
 770                                 || (Map.null descendants &&
 771                                         Foldable.any
 772                                                  (not . H.quantity_null . H.depolarize)
 773                                                  (H.unBalance_by_Account_Sum $ Strict.inclusive bal))
 774                                 -- NOTE: worth if Account's exclusive
 775                                 -- has at least a non-zero Amount
 776                                 || (Foldable.any
 777                                          (not . H.quantity_null . H.depolarize)
 778                                          (H.unBalance_by_Account_Sum $ Strict.exclusive bal))
 779                                 -- NOTE: worth if Account has at least more than
 780                                 -- one descendant Account whose inclusive
 781                                 -- has at least a non-zero Amount
 782                                 || Map.size
 783                                          ( Map.filter
 784                                                  ( Strict.maybe False
 785                                                          ( Foldable.any
 786                                                                  (not . H.quantity_null . H.depolarize)
 787                                                          . H.unBalance_by_Account_Sum
 788                                                          . Strict.inclusive )
 789                                                  . TreeMap.node_value )
 790                                                  descendants
 791                                          ) > 1
 792 instance Format.Journal_Filter Context (Const Forall_Journal_Balance_by_Account_Expanded) () where
 793         journal_filter ctx
 794          (Const (Forall_Journal_Balance_by_Account_Expanded j)) =
 795                 Const $ Forall_Journal_Balance_by_Account_Expanded $
 796                 Format.journal_filter ctx j
 797
 798 -- Instances 'Format.Journal_Leijen_Table_Cells'
 799
 800 instance Format.Journal_Leijen_Table_Cells (Const Forall_Journal_Balance_by_Account_Expanded) x where
 801         journal_leijen_table_cells
 802          (Const (Forall_Journal_Balance_by_Account_Expanded j)) =
 803                 Format.journal_leijen_table_cells j
 804
 805 -- Instances H.Balance_by_Account -> H.Balance_Expanded
 806
 807 instance
 808  ( Functor j
 809  , Journal_Balance_by_Account_Expanded j (H.Balance_Expanded as u q)
 810
 811  -- NOTE: constraints from H.balance_expanded
 812  , Ord as
 813  , Ord u
 814  , H.Addable q
 815  ) => Format.Journal_Wrap (j (H.Balance_by_Account as u q))
 816                           Forall_Journal_Balance_by_Account_Expanded where
 817         journal_wrap =
 818                 Forall_Journal_Balance_by_Account_Expanded .
 819                 fmap H.balance_expanded
 820
 821 instance Format.Journal_Wrap Forall_Journal_Balance_by_Account
 822                              Forall_Journal_Balance_by_Account_Expanded where
 823         journal_wrap (Forall_Journal_Balance_by_Account j) = Format.journal_wrap j
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835 -- * 'H.Balance_by_Unit'
 836
 837 type Format_Journal_Balance_by_Unit
 838  = Format
 839    (   JCC.Journal Balance_by_Unit_JCC)
 840    (Ledger.Journal Balance_by_Unit_Ledger)
 841
 842 -- JCC
 843 type Balance_by_Unit_JCC
 844  = H.Balance_by_Unit JCC.Account
 845                      JCC.Unit
 846                      (H.Polarized JCC.Quantity)
 847 instance Format.Journal (JCC.Journal Balance_by_Unit_JCC) where
 848         type Journal_Format   (JCC.Journal Balance_by_Unit_JCC)
 849          = Format_Journal_Balance_by_Unit
 850         journal_format = Format_JCC
 851
 852 -- Ledger
 853 type Balance_by_Unit_Ledger
 854  = H.Balance_by_Unit Ledger.Account
 855                      Ledger.Unit
 856                      (H.Polarized Ledger.Quantity)
 857 instance Format.Journal (Ledger.Journal Balance_by_Unit_Ledger) where
 858         type Journal_Format   (Ledger.Journal Balance_by_Unit_Ledger)
 859          = Format_Journal_Balance_by_Unit
 860         journal_format = Format_Ledger
 861
 862 -- ** Class 'Journal_Balance_by_Unit'
 863
 864 class
 865  ( Format.Journal (j m)
 866  , Format.Journal_Format (j m) ~ Format_Journal_Balance_by_Unit
 867  , Format.Journal_Leijen_Table_Cells j m
 868  -- , Journal_Equilibrium_Postings j m
 869  )
 870  => Journal_Balance_by_Unit j m
 871
 872 instance Journal_Balance_by_Unit    JCC.Journal Balance_by_Unit_JCC
 873 instance Journal_Balance_by_Unit Ledger.Journal Balance_by_Unit_Ledger
 874
 875 -- ** Type 'Forall_Journal_Balance_by_Unit'
 876
 877 data    Forall_Journal_Balance_by_Unit
 878  = forall j m. Journal_Balance_by_Unit  j m
 879  =>     Forall_Journal_Balance_by_Unit (j m)
 880
 881 instance Format.Journal Forall_Journal_Balance_by_Unit where
 882         type Journal_Format   Forall_Journal_Balance_by_Unit = Format_Journal_Balance_by_Unit
 883         journal_format (Forall_Journal_Balance_by_Unit j) = Format.journal_format j
 884
 885 -- Instances H.Balance_by_Account -> H.Balance_by_Unit
 886
 887 instance
 888  ( Functor j
 889  , Journal_Balance_by_Unit j (H.Balance_by_Unit (H.Account_Path as) u q)
 890
 891  -- NOTE: constraints from H.balance_by_unit_of_by_account
 892  , H.Account (H.Account_Path as)
 893  , Ord as
 894  , Ord u
 895  , H.Addable q
 896  ) => Format.Journal_Wrap (j (H.Balance_by_Account as u q))
 897                           Forall_Journal_Balance_by_Unit where
 898         journal_wrap =
 899                 Forall_Journal_Balance_by_Unit .
 900                 fmap (flip H.balance_by_unit_of_by_account mempty)
 901
 902 instance Format.Journal_Wrap Forall_Journal_Balance_by_Account
 903                              Forall_Journal_Balance_by_Unit where
 904         journal_wrap
 905          (Forall_Journal_Balance_by_Account j) =
 906                 Format.journal_wrap j
 907
 908 -- Instances H.Balance_Expanded -> H.Balance_by_Unit
 909
 910 instance
 911  ( Functor j
 912  , Journal_Balance_by_Unit j (H.Balance_by_Unit (H.Account_Path as) u q)
 913
 914  -- NOTE: constraints from H.balance_by_unit_of_expanded
 915  , H.Account (H.Account_Path as)
 916  , Ord as
 917  , Ord u
 918  , H.Addable q
 919  ) => Format.Journal_Wrap (j (H.Balance_Expanded as u q))
 920                           Forall_Journal_Balance_by_Unit where
 921         journal_wrap =
 922                 Forall_Journal_Balance_by_Unit .
 923                 fmap (flip H.balance_by_unit_of_expanded mempty)
 924
 925 instance Format.Journal_Wrap Forall_Journal_Balance_by_Account_Expanded
 926                              Forall_Journal_Balance_by_Unit where
 927         journal_wrap
 928          (Forall_Journal_Balance_by_Account_Expanded j) =
 929                 Format.journal_wrap j
 930
 931 -- Instances 'Format.Journal_Leijen_Table_Cells'
 932
 933 instance
 934  ( Format.Journal_Content j
 935  , Journal j
 936
 937  , a ~ Format.Journal_Account j
 938  , H.Account a
 939  , u ~ Format.Journal_Unit j
 940  , Ord u
 941  , q ~ Format.Journal_Quantity j
 942  , H.Addable (Format.Journal_Quantity j)
 943  ) => Format.Journal_Leijen_Table_Cells j (H.Balance_by_Unit a u (H.Polarized q)) where
 944         journal_leijen_table_cells jnl acc =
 945                 let H.Balance_by_Unit bal = Format.journal_content jnl in
 946                 Map.foldrWithKey
 947                  (\unit amt ->
 948                         let qty = H.balance_by_unit_sum_quantity amt in
 949                         zipWith (:)
 950                                 [ Leijen.Table.cell_of_forall_param jnl $ (unit,) <$> H.polarized_positive qty
 951                                 , Leijen.Table.cell_of_forall_param jnl $ (unit,) <$> H.polarized_negative qty
 952                                 , Leijen.Table.cell_of_forall_param jnl (unit, H.depolarize qty)
 953                                 , Leijen.Table.cell
 954                                 ]
 955                  ) acc bal
 956 instance Format.Journal_Leijen_Table_Cells (Const Forall_Journal_Balance_by_Unit) () where
 957         journal_leijen_table_cells
 958          (Const (Forall_Journal_Balance_by_Unit j)) =
 959                 Format.journal_leijen_table_cells j
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969 -- * Class 'Journal'
 970
 971 class
 972  ( Leijen.Table.Cell_of_forall_param j (Format.Journal_Unit j, Format.Journal_Quantity j)
 973  , W.ToDoc1 j [Format.Journal_Transaction j]
 974  ) => Journal (j:: * -> *) where
 975         journal_posting
 976          :: forall m. j m
 977          -> H.Account_Path (Format.Journal_Account_Section j)
 978          -> Map (Format.Journal_Unit j)
 979                 (Format.Journal_Quantity j)
 980          -> [Text] -- ^ Comments
 981          -> Format.Journal_Posting j
 982         journal_transaction
 983          :: forall m. j m
 984          -> Text -- ^ Wording
 985          -> (H.Date, [H.Date])
 986          -> Map (H.Account_Path (Format.Journal_Account_Section j))
 987                 [Format.Journal_Posting j]
 988          -> Format.Journal_Transaction j
 989
 990 instance Journal JCC.Journal where
 991         journal_posting _j acct
 992          posting_amounts
 993          posting_comments =
 994                 (JCC.posting acct)
 995                  { JCC.posting_amounts
 996                  , JCC.posting_comments
 997                  }
 998         journal_transaction _j
 999          transaction_wording
1000          transaction_dates
1001          transaction_postings =
1002                 JCC.transaction
1003                  { JCC.transaction_wording
1004                  , JCC.transaction_dates
1005                  , JCC.transaction_postings
1006                  }
1007 instance Journal Ledger.Journal where
1008         journal_posting _j acct
1009          posting_amounts
1010          posting_comments =
1011                 (Ledger.posting acct)
1012                  { Ledger.posting_amounts
1013                  , Ledger.posting_comments
1014                  }
1015         journal_transaction _j
1016          transaction_wording
1017          transaction_dates
1018          transaction_postings =
1019                 Ledger.transaction
1020                  { Ledger.transaction_wording
1021                  , Ledger.transaction_dates
1022                  , Ledger.transaction_postings
1023                  }
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037 -- * Class 'Journal_Equilibrium_Transaction'
1038
1039 class Journal_Equilibrium_Transaction j m where
1040         journal_equilibrium_transaction
1041          :: j m
1042          -> C.Context
1043          -> Context
1044          -> Lang.Exercise_OC
1045          -> H.Date
1046          -> W.Doc
1047
1048 instance
1049  ( Format.Journal_Content j
1050  , Journal j
1051
1052  , as ~ Format.Journal_Account_Section j
1053  , Format.Journal_Account_Section j ~ Text
1054  , Format.Journal_Account j ~ TreeMap.Path Text
1055  , Num quantity
1056  , quantity ~ Format.Journal_Quantity j
1057  , Ord unit
1058  , Ord quantity
1059  , H.Zero (Format.Journal_Quantity j)
1060  , H.Addable (Format.Journal_Quantity j)
1061  , unit ~ Format.Journal_Unit j
1062  ) => Journal_Equilibrium_Transaction
1063  j (H.Balance_by_Account as unit (H.Polarized quantity)) where
1064         journal_equilibrium_transaction
1065          j c ctx oc now =
1066                 let bal_by_account = Format.journal_content j in
1067                 let H.Balance_by_Unit bal_by_unit =
1068                         H.balance_by_unit_of_by_account bal_by_account mempty in
1069                 let postings =
1070                         Map.foldlWithKey
1071                          (\acc unit H.Balance_by_Unit_Sum{..} ->
1072                                 let qty =
1073                                         (case oc of
1074                                          Lang.Exercise_Closing -> id
1075                                          Lang.Exercise_Opening -> negate) $
1076                                         H.depolarize balance_by_unit_sum_quantity in
1077                                 case H.quantity_sign qty of
1078                                  LT ->
1079                                         let account = snd $ ctx_account_equilibrium ctx in
1080                                         Map.insertWith mappend account
1081                                          [journal_posting j account
1082                                                  (Map.singleton unit qty)
1083                                                  [ Lang.translate (C.lang c) Lang.Comment_Equilibrium ]]
1084                                          acc
1085                                  EQ -> acc
1086                                  GT ->
1087                                         let account = fst $ ctx_account_equilibrium ctx in
1088                                         Map.insertWith mappend account
1089                                          [journal_posting j account
1090                                                  (Map.singleton unit qty)
1091                                                  [ Lang.translate (C.lang c) Lang.Comment_Equilibrium ]]
1092                                          acc
1093                          )
1094                          Map.empty
1095                          bal_by_unit
1096                  in
1097                 W.toDoc1 j [
1098                 journal_transaction j
1099                  (Lang.translate (C.lang c) (Lang.Description_Exercise oc))
1100                  (now{Time.utctDayTime=0}, []) $
1101                 Map.unionWith mappend postings $
1102                 TreeMap.flatten_with_Path
1103                  (\posting_account (H.Balance_by_Account_Sum amount_by_unit) ->
1104                         [ journal_posting j posting_account
1105                                  (flip fmap amount_by_unit $
1106                                         (case oc of
1107                                          Lang.Exercise_Closing -> negate
1108                                          Lang.Exercise_Opening -> id)
1109                                         . H.depolarize)
1110                                  []
1111                         ]
1112                  )
1113                  bal_by_account
1114                  ]
1115
1116 instance Journal_Equilibrium_Transaction (Const Forall_Journal_Balance_by_Account) () where
1117         journal_equilibrium_transaction
1118          (Const (Forall_Journal_Balance_by_Account j)) =
1119                 journal_equilibrium_transaction j
1120
1121 {-
1122 instance
1123   ToDoc (C.Context, Context, Date, Lang.Exercise_OC)
1124         ( Forall_Journal_Balance_by_Account
1125         , Forall_Journal_Balance_by_Unit ) where
1126         toDoc c
1127          ( Forall_Journal_Balance_by_Account bal_by_account
1128          , Forall_Journal_Balance_by_Unit    bal_by_unit
1129          ) =
1130                 toDoc c (bal_by_account, bal_by_unit)
1131 -}