1 {-| 
    2 
    3 Print some statistics for the ledger.
    4 
    5 -}
    6 
    7 module Commands.Stats
    8 where
    9 import Prelude hiding (putStr)
   10 import qualified Data.Map as Map
   11 import Data.Map ((!))
   12 import Ledger
   13 import Options
   14 import System.IO.UTF8
   15 import Utils (filterAndCacheLedgerWithOpts)
   16 
   17 
   18 -- | Print various statistics for the ledger.
   19 stats :: [Opt] -> [String] -> Ledger -> IO ()
   20 stats opts args l = do
   21   today <- getCurrentDay
   22   putStr $ showStats opts args l today
   23 
   24 showStats :: [Opt] -> [String] -> Ledger -> Day -> String
   25 showStats opts args l today = 
   26     heading ++ (unlines $ map (\(a,b) -> printf fmt a b) stats)
   27     where
   28       heading = underline $ printf "Ledger statistics as of %s" (show today)
   29       fmt = "%-" ++ (show w1) ++ "s: %-" ++ (show w2) ++ "s"
   30       w1 = maximum $ map (length . fst) stats
   31       w2 = maximum $ map (length . show . snd) stats
   32       stats = [
   33          ("File", filepath $ rawledger l)
   34         ,("Period", printf "%s to %s (%d days)" (start span) (end span) days)
   35         ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)
   36         ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30)
   37         ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)
   38         ,("Last transaction", maybe "none" show lastdate ++
   39                               maybe "" (printf " (%d days ago)") lastelapsed)
   40 --        ,("Payees/descriptions", show $ length $ nub $ map ltdescription ts)
   41         ,("Accounts", show $ length $ accounts l)
   42         ,("Commodities", show $ length $ commodities l)
   43       -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
   44       -- Uncleared transactions      : %(uncleared)s
   45       -- Days since reconciliation   : %(reconcileelapsed)s
   46       -- Days since last transaction : %(recentelapsed)s
   47        ]
   48            where 
   49              ts = sortBy (comparing ltdate) $ ledger_txns $ rawledger l
   50              lastdate | null ts = Nothing
   51                       | otherwise = Just $ ltdate $ last ts
   52              lastelapsed = maybe Nothing (Just . diffDays today) lastdate
   53              tnum = length ts
   54              span = rawdatespan l
   55              start (DateSpan (Just d) _) = show d
   56              start _ = ""
   57              end (DateSpan _ (Just d)) = show d
   58              end _ = ""
   59              days = fromMaybe 0 $ daysInSpan span
   60              txnrate | days==0 = 0
   61                      | otherwise = fromIntegral tnum / fromIntegral days :: Double
   62              tnum30 = length $ filter withinlast30 ts
   63              withinlast30 t = (d>=(addDays (-30) today) && (d<=today)) where d = ltdate t
   64              txnrate30 = fromIntegral tnum30 / 30 :: Double
   65              tnum7 = length $ filter withinlast7 ts
   66              withinlast7 t = (d>=(addDays (-7) today) && (d<=today)) where d = ltdate t
   67              txnrate7 = fromIntegral tnum7 / 7 :: Double
   68