diff --git a/Options.hs b/Options.hs index 1fc4fb88a..5603674ab 100644 --- a/Options.hs +++ b/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 diff --git a/StatsCommand.hs b/StatsCommand.hs new file mode 100644 index 000000000..d78595da1 --- /dev/null +++ b/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 + diff --git a/hledger.hs b/hledger.hs index 5c0eb1c40..897efae93 100644 --- a/hledger.hs +++ b/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