abstracting over balancesheet, incomestatement, and cashflow with BalanceView

hledger/Hledger/Cli/BalanceView.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
+
+module Hledger.Cli.BalanceView (
+  BalanceView(..)
+ ,balanceviewReport
+) where
+
+import Data.Time.Calendar
+import Data.List
+import Data.Monoid (Sum(..), (<>))
+import qualified Data.Text as T
+
+import Hledger
+import Hledger.Cli.Balance
+import Hledger.Cli.CliOptions
+
+data BalanceView = BV { bvname    :: String
+                      , bvqueries :: [(String, Journal -> Query)]
+                      }
+
+balanceviewQueryReport
+    :: ReportOpts
+    -> Day
+    -> Journal
+    -> String
+    -> (Journal -> Query)
+    -> ([String], Sum MixedAmount)
+balanceviewQueryReport ropts d j t q = ([view], Sum amt)
+    where
+      q' = And [queryFromOpts d (withoutBeginDate ropts), q j]
+      rep@(_ , amt) = balanceReport ropts q' j
+      view = intercalate "\n" [t <> ":", balanceReportAsText ropts rep]
+
+balanceviewReport :: BalanceView -> CliOpts -> Journal -> IO ()
+balanceviewReport BV{..} CliOpts{reportopts_=ropts} j = do
+  d <- getCurrentDay
+  let (views, amt) = foldMap (uncurry (balanceviewQueryReport ropts d j)) bvqueries
+  mapM_ putStrLn (bvname : "" : views)
+  putStrLn . unlines $
+    [ "Total:"
+    , "--------------------"
+    , padleft 20 $ showMixedAmountWithoutPrice (getSum amt)
+    ]
+
+withoutBeginDate :: ReportOpts -> ReportOpts
+withoutBeginDate ropts@ReportOpts{..} = ropts{period_=p}
+  where
+    p = dateSpanAsPeriod $ DateSpan Nothing (periodEnd period_)
+

hledger/Hledger/Cli/Balancesheet.hs

@@ -19,6 +19,7 @@ import Text.Shakespeare.Text
 import Hledger
 import Hledger.Cli.CliOptions
 import Hledger.Cli.Balance
+import Hledger.Cli.BalanceView
 
 
 balancesheetmode :: Mode RawOpts
@@ -35,30 +36,13 @@ balancesheetmode = (defCommandMode $ ["balancesheet"]++aliases) {
  }
   where aliases = ["bs"]
 
--- | Print a simple balance sheet.
 balancesheet :: CliOpts -> Journal -> IO ()
-balancesheet CliOpts{reportopts_=ropts} j = do
-  -- let lines = case lineFormatFromOpts ropts of Left err, Right ...
-  d <- getCurrentDay
-  let q = queryFromOpts d (withoutBeginDate ropts)
-      assetreport@(_,assets)          = balanceReport ropts (And [q, journalAssetAccountQuery j]) j
-      liabilityreport@(_,liabilities) = balanceReport ropts (And [q, journalLiabilityAccountQuery j]) j
-      total = assets + liabilities
-  LT.putStr $ [lt|Balance Sheet
-
-Assets:
-#{balanceReportAsText ropts assetreport}
-Liabilities:
-#{balanceReportAsText ropts liabilityreport}
-Total:
---------------------
-#{padleft 20 $ showMixedAmountWithoutPrice total}
-|]
-
-withoutBeginDate :: ReportOpts -> ReportOpts
-withoutBeginDate ropts@ReportOpts{..} = ropts{period_=p}
+balancesheet = balanceviewReport bv
   where
-    p = dateSpanAsPeriod $ DateSpan Nothing (periodEnd period_)
+    bv = BV "Balance Sheet"
+            [ ("Assets", journalAssetAccountQuery)
+            , ("Liabilities", journalLiabilityAccountQuery)
+            ]
 
 tests_Hledger_Cli_Balancesheet :: Test
 tests_Hledger_Cli_Balancesheet = TestList

hledger/hledger.cabal

@@ -144,6 +144,7 @@ library
       Hledger.Cli.Accounts
       Hledger.Cli.Balance
       Hledger.Cli.Balancesheet
+      Hledger.Cli.BalanceView
       Hledger.Cli.Cashflow
       Hledger.Cli.Help
       Hledger.Cli.Histogram

hledger/package.yaml

@@ -93,6 +93,7 @@ library:
   - Hledger.Cli.Accounts
   - Hledger.Cli.Balance
   - Hledger.Cli.Balancesheet
+  - Hledger.Cli.BalanceView
   - Hledger.Cli.Cashflow
   - Hledger.Cli.Help
   - Hledger.Cli.Histogram