{-|

Print some statistics for the journal.

-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NamedFieldPuns #-}

module Hledger.Cli.Commands.Stats (
  statsmode
 ,stats
)
where

import Data.Default (def)
import Data.List (nub, sortOn)
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe)
import Data.HashSet (size, fromList)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Calendar (Day, addDays, diffDays)
import System.Console.CmdArgs.Explicit hiding (Group)
import Text.Printf (printf)
import qualified Data.Map as Map

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (writeOutputLazyText)
import Text.Tabular.AsciiWide
import Data.Time.Clock.POSIX (getPOSIXTime)


statsmode :: Mode RawOpts
statsmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Stats.txt")
  [[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq  [CommandDoc
"output-file",CommandDoc
"o"]   (\CommandDoc
s RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt CommandDoc
"output-file" CommandDoc
s RawOpts
opts) CommandDoc
"FILE" CommandDoc
"write output to FILE."
  ]
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")

-- like Register.summarisePostings
-- | Print various statistics for the journal.
stats :: CliOpts -> Journal -> IO ()
stats :: CliOpts -> Journal -> IO ()
stats opts :: CliOpts
opts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec, POSIXTime
progstarttime_ :: CliOpts -> POSIXTime
progstarttime_ :: POSIXTime
progstarttime_} Journal
j = do
  let today :: Day
today = ReportSpec -> Day
_rsDay ReportSpec
rspec
      q :: Query
q = ReportSpec -> Query
_rsQuery ReportSpec
rspec
      l :: Ledger
l = Query -> Journal -> Ledger
ledgerFromJournal Query
q Journal
j
      reportspan :: DateSpan
reportspan = Ledger -> DateSpan
ledgerDateSpan Ledger
l DateSpan -> DateSpan -> DateSpan
`spanDefaultsFrom` Bool -> Query -> DateSpan
queryDateSpan Bool
False Query
q
      intervalspans :: [DateSpan]
intervalspans = Interval -> DateSpan -> [DateSpan]
splitSpan (ReportOpts -> Interval
interval_ (ReportOpts -> Interval) -> ReportOpts -> Interval
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) DateSpan
reportspan
      showstats :: DateSpan -> (Builder, Int)
showstats = Ledger -> Day -> DateSpan -> (Builder, Int)
showLedgerStats Ledger
l Day
today
      ([Builder]
ls, [Int]
txncounts) = [(Builder, Int)] -> ([Builder], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Builder, Int)] -> ([Builder], [Int]))
-> [(Builder, Int)] -> ([Builder], [Int])
forall a b. (a -> b) -> a -> b
$ (DateSpan -> (Builder, Int)) -> [DateSpan] -> [(Builder, Int)]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> (Builder, Int)
showstats [DateSpan]
intervalspans
      numtxns :: Int
numtxns = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
txncounts
      b :: Builder
b = [Builder] -> Builder
unlinesB [Builder]
ls
  CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TB.toLazyText Builder
b
  POSIXTime
t <- IO POSIXTime
getPOSIXTime
  let dt :: POSIXTime
dt = POSIXTime
t POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
progstarttime_
  CommandDoc -> Float -> Float -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"Run time (throughput)    : %.2fs (%.0f txns/s)\n" 
    (POSIXTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
dt :: Float) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numtxns Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ POSIXTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
dt :: Float)

showLedgerStats :: Ledger -> Day -> DateSpan -> (TB.Builder, Int)
showLedgerStats :: Ledger -> Day -> DateSpan -> (Builder, Int)
showLedgerStats Ledger
l Day
today DateSpan
span =
    ([Builder] -> Builder
unlinesB ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ ((Text, CommandDoc) -> Builder)
-> [(Text, CommandDoc)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (TableOpts -> Header Cell -> Builder
renderRowB TableOpts
forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False} (Header Cell -> Builder)
-> ((Text, CommandDoc) -> Header Cell)
-> (Text, CommandDoc)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, CommandDoc) -> Header Cell
showRow) [(Text, CommandDoc)]
stats
    ,Int
tnum)
  where
    showRow :: (Text, CommandDoc) -> Header Cell
showRow (Text
label, CommandDoc
value) = Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Header Cell) -> [Header Cell] -> Header Cell
forall a b. (a -> b) -> a -> b
$ (Text -> Header Cell) -> [Text] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Cell -> Header Cell
forall h. h -> Header h
Header (Cell -> Header Cell) -> (Text -> Cell) -> Text -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Align -> Text -> Cell
textCell Align
TopLeft)
      [Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w1) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w1) Bool
False Bool
True Text
label Text -> Text -> Text
`T.append` Text
": ", CommandDoc -> Text
T.pack CommandDoc
value]
    w1 :: Int
w1 = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Text, CommandDoc) -> Int) -> [(Text, CommandDoc)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int)
-> ((Text, CommandDoc) -> Text) -> (Text, CommandDoc) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, CommandDoc) -> Text
forall a b. (a, b) -> a
fst) [(Text, CommandDoc)]
stats
    ([(Text, CommandDoc)]
stats, Int
tnum) = ([
       (Text
"Main file", CommandDoc
path) -- ++ " (from " ++ source ++ ")")
      ,(Text
"Included files", [CommandDoc] -> CommandDoc
unlines ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
drop Int
1 ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ Journal -> [CommandDoc]
journalFilePaths Journal
j)
      ,(Text
"Transactions span", CommandDoc -> CommandDoc -> CommandDoc -> Integer -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s to %s (%d days)" (DateSpan -> CommandDoc
start DateSpan
span) (DateSpan -> CommandDoc
end DateSpan
span) Integer
days)
      ,(Text
"Last transaction", CommandDoc -> (Day -> CommandDoc) -> Maybe Day -> CommandDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CommandDoc
"none" Day -> CommandDoc
forall a. Show a => a -> CommandDoc
show Maybe Day
lastdate CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ Maybe Integer -> CommandDoc
forall p t.
(IsString p, PrintfArg t, PrintfType p, Ord t, Num t) =>
Maybe t -> p
showelapsed Maybe Integer
lastelapsed)
      ,(Text
"Transactions", CommandDoc -> Int -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (%0.1f per day)" Int
tnum Double
txnrate)
      ,(Text
"Transactions last 30 days", CommandDoc -> Int -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (%0.1f per day)" Int
tnum30 Double
txnrate30)
      ,(Text
"Transactions last 7 days", CommandDoc -> Int -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (%0.1f per day)" Int
tnum7 Double
txnrate7)
      ,(Text
"Payees/descriptions", Int -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Int -> CommandDoc) -> Int -> CommandDoc
forall a b. (a -> b) -> a -> b
$ HashSet Text -> Int
forall a. HashSet a -> Int
size (HashSet Text -> Int) -> HashSet Text -> Int
forall a b. (a -> b) -> a -> b
$ [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ (Transaction -> Text) -> [Transaction] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> Text
tdescription) [Transaction]
ts)
      ,(Text
"Accounts", CommandDoc -> Int -> Int -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (depth %d)" Int
acctnum Int
acctdepth)
      ,(Text
"Commodities", CommandDoc -> CommandDoc -> Text -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s (%s)" (Int -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Int -> CommandDoc) -> Int -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
cs) (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
cs))
      ,(Text
"Market prices", CommandDoc -> CommandDoc -> Text -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s (%s)" (Int -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Int -> CommandDoc) -> Int -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [PriceDirective] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PriceDirective]
mktprices) (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
mktpricecommodities))
    -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
    -- Unmarked transactions      : %(unmarked)s
    -- Days since reconciliation   : %(reconcileelapsed)s
    -- Days since last transaction : %(recentelapsed)s
     ] 
     ,Int
tnum)
       where
         j :: Journal
j = Ledger -> Journal
ljournal Ledger
l
         path :: CommandDoc
path = Journal -> CommandDoc
journalFilePath Journal
j
         ts :: [Transaction]
ts = (Transaction -> Day) -> [Transaction] -> [Transaction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Transaction -> Day
tdate ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Day -> Bool
spanContainsDate DateSpan
span (Day -> Bool) -> (Transaction -> Day) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Day
tdate) ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
         as :: [Text]
as = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Posting -> Text) -> [Posting] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount ([Posting] -> [Text]) -> [Posting] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings [Transaction]
ts
         cs :: [Text]
cs = (CommandDoc -> [Text])
-> (Map Text AmountStyle -> [Text])
-> Either CommandDoc (Map Text AmountStyle)
-> [Text]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CommandDoc -> [Text]
forall a. CommandDoc -> a
error' Map Text AmountStyle -> [Text]
forall k a. Map k a -> [k]
Map.keys (Either CommandDoc (Map Text AmountStyle) -> [Text])
-> Either CommandDoc (Map Text AmountStyle) -> [Text]
forall a b. (a -> b) -> a -> b
$ [Amount] -> Either CommandDoc (Map Text AmountStyle)
commodityStylesFromAmounts ([Amount] -> Either CommandDoc (Map Text AmountStyle))
-> [Amount] -> Either CommandDoc (Map Text AmountStyle)
forall a b. (a -> b) -> a -> b
$ (Posting -> [Amount]) -> [Posting] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amountsRaw (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) ([Posting] -> [Amount]) -> [Posting] -> [Amount]
forall a b. (a -> b) -> a -> b
$ (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings [Transaction]
ts  -- PARTIAL:
         lastdate :: Maybe Day
lastdate | [Transaction] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts = Maybe Day
forall a. Maybe a
Nothing
                  | Bool
otherwise = Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Transaction -> Day
tdate (Transaction -> Day) -> Transaction -> Day
forall a b. (a -> b) -> a -> b
$ [Transaction] -> Transaction
forall a. [a] -> a
last [Transaction]
ts
         lastelapsed :: Maybe Integer
lastelapsed = (Day -> Integer) -> Maybe Day -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Day -> Day -> Integer
diffDays Day
today) Maybe Day
lastdate
         showelapsed :: Maybe t -> p
showelapsed Maybe t
Nothing = p
""
         showelapsed (Just t
days) = CommandDoc -> t -> CommandDoc -> p
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
" (%d %s)" t
days' CommandDoc
direction
                                   where days' :: t
days' = t -> t
forall a. Num a => a -> a
abs t
days
                                         direction :: CommandDoc
direction | t
days t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0 = CommandDoc
"days ago" :: String
                                                   | Bool
otherwise = CommandDoc
"days from now"
         tnum :: Int
tnum = [Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts  -- Integer would be better
         start :: DateSpan -> CommandDoc
start (DateSpan (Just Day
d) Maybe Day
_) = Day -> CommandDoc
forall a. Show a => a -> CommandDoc
show Day
d
         start DateSpan
_ = CommandDoc
""
         end :: DateSpan -> CommandDoc
end (DateSpan Maybe Day
_ (Just Day
d)) = Day -> CommandDoc
forall a. Show a => a -> CommandDoc
show Day
d
         end DateSpan
_ = CommandDoc
""
         days :: Integer
days = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Integer
daysInSpan DateSpan
span
         txnrate :: Double
txnrate | Integer
daysInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
0 = Double
0
                 | Bool
otherwise = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tnum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
days :: Double
         tnum30 :: Int
tnum30 = [Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter Transaction -> Bool
withinlast30 [Transaction]
ts
         withinlast30 :: Transaction -> Bool
withinlast30 Transaction
t = Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Day -> Day
addDays (-Integer
30) Day
today Bool -> Bool -> Bool
&& (Day
dDay -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<=Day
today) where d :: Day
d = Transaction -> Day
tdate Transaction
t
         txnrate30 :: Double
txnrate30 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tnum30 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
30 :: Double
         tnum7 :: Int
tnum7 = [Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter Transaction -> Bool
withinlast7 [Transaction]
ts
         withinlast7 :: Transaction -> Bool
withinlast7 Transaction
t = Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Day -> Day
addDays (-Integer
7) Day
today Bool -> Bool -> Bool
&& (Day
dDay -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<=Day
today) where d :: Day
d = Transaction -> Day
tdate Transaction
t
         txnrate7 :: Double
txnrate7 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tnum7 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
7 :: Double
         acctnum :: Int
acctnum = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
as
         acctdepth :: Int
acctdepth | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
as = Int
0
                   | Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
accountNameLevel [Text]
as
         mktprices :: [PriceDirective]
mktprices = Journal -> [PriceDirective]
jpricedirectives Journal
j
         mktpricecommodities :: [Text]
mktpricecommodities = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (PriceDirective -> Text) -> [PriceDirective] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> Text
pdcommodity [PriceDirective]
mktprices