new "stats" command, like my old ledgerstats

Options.hs

@@ -39,6 +39,7 @@ usagehdr = (
   "  histogram - show transaction counts per day or other interval\n" ++
   "  print     - show transactions in ledger format\n" ++
   "  register  - show transactions as a register with running balance\n" ++
+  "  stats     - show various statistics for a ledger\n" ++
 #ifdef VTY
   "  ui        - run a simple curses-based text ui\n" ++
 #endif

StatsCommand.hs

@@ -0,0 +1,59 @@
+{-| 
+
+Print some statistics for the ledger.
+
+-}
+
+module StatsCommand
+where
+import Prelude hiding (putStr)
+import qualified Data.Map as Map
+import Data.Map ((!))
+import Ledger
+import Options
+import System.IO.UTF8
+import Utils (filterAndCacheLedgerWithOpts)
+
+
+-- | Print various statistics for the ledger.
+stats :: [Opt] -> [String] -> Ledger -> IO ()
+stats opts args l = do
+  today <- getCurrentDay
+  putStr $ showStats opts args l today
+
+showStats :: [Opt] -> [String] -> Ledger -> Day -> String
+showStats opts args l today = 
+    heading ++ (unlines $ map (\(a,b) -> printf fmt a b) stats)
+    where
+      heading = underline $ printf "Ledger statistics as of %s" (show today)
+      fmt = "%-" ++ (show w1) ++ "s: %-" ++ (show w2) ++ "s"
+      w1 = maximum $ map (length . fst) stats
+      w2 = maximum $ map (length . show . snd) stats
+      stats = [
+         ("File", filepath $ rawledger l)
+        ,("Period", printf "%s to %s (%d days)" (start span) (end span) days)
+        ,("Transactions", printf "%d (%0.1f per day)" txns txnrate)
+        ,("Transactions last 30 days", printf "%d (%0.1f per day)" txns30 txnrate30)
+        ,("Payees/descriptions", show $ length $ nub $ map ltdescription rawledgertransactions)
+        ,("Accounts", show $ length $ accounts l)
+        ,("Commodities", show $ length $ commodities l)
+      -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
+      -- Uncleared transactions      : %(uncleared)s
+      -- Days since reconciliation   : %(reconcileelapsed)s
+      -- Days since last transaction : %(recentelapsed)s
+       ]
+           where 
+             rawledgertransactions = ledger_txns $ rawledger l
+             txns = length rawledgertransactions
+             span = rawdatespan l
+             start (DateSpan (Just d) _) = show d
+             start _ = ""
+             end (DateSpan _ (Just d)) = show d
+             end _ = ""
+             days = fromMaybe 0 $ daysInSpan span
+             txnrate | days==0 = 0
+                     | otherwise = fromIntegral txns / fromIntegral days :: Float
+             txns30 = length $ filter withinlast30 rawledgertransactions
+             withinlast30 t = (d>=(addDays (-30) today) && (d<=today)) where d = ltdate t
+             txnrate30 = fromIntegral txns30 / 30 :: Float
+

hledger.hs

@@ -46,6 +46,7 @@ module Main (
              module RegisterCommand,
              module HistogramCommand,
              module AddCommand,
+             module StatsCommand,
 #ifdef VTY
              module UICommand,
 #endif
@@ -71,6 +72,7 @@ import PrintCommand
 import RegisterCommand
 import HistogramCommand
 import AddCommand
+import StatsCommand
 #ifdef VTY
 import UICommand
 #endif
@@ -93,6 +95,7 @@ main = do
        | cmd `isPrefixOf` "register"  = withLedgerDo opts args cmd register
        | cmd `isPrefixOf` "histogram" = withLedgerDo opts args cmd histogram
        | cmd `isPrefixOf` "add"       = withLedgerDo opts args cmd add
+       | cmd `isPrefixOf` "stats"     = withLedgerDo opts args cmd stats
 #ifdef VTY
        | cmd `isPrefixOf` "ui"        = withLedgerDo opts args cmd ui
 #endif