{-|

Print some statistics for the journal.

-}

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

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

import Data.List
import Data.List.Extra (nubSort)
import Data.Maybe
import Data.Ord
import Data.HashSet (size, fromList)
-- import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import System.Console.CmdArgs.Explicit
import Text.Printf
import qualified Data.Map as Map

import Hledger
import Hledger.Cli.CliOptions
import Prelude hiding (putStr)
import Hledger.Cli.Utils (writeOutput)


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} Journal
j = do
  Day
d <- IO Day
getCurrentDay
  let 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
rsOpts ReportSpec
rspec) DateSpan
reportspan
      showstats :: DateSpan -> CommandDoc
showstats = Ledger -> Day -> DateSpan -> CommandDoc
showLedgerStats Ledger
l Day
d
      s :: CommandDoc
s = CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate CommandDoc
"\n" ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ (DateSpan -> CommandDoc) -> [DateSpan] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> CommandDoc
showstats [DateSpan]
intervalspans
  CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts CommandDoc
s

showLedgerStats :: Ledger -> Day -> DateSpan -> String
showLedgerStats :: Ledger -> Day -> DateSpan -> CommandDoc
showLedgerStats Ledger
l Day
today DateSpan
span =
    [CommandDoc] -> CommandDoc
unlines ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ((CommandDoc, CommandDoc) -> CommandDoc)
-> [(CommandDoc, CommandDoc)] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(CommandDoc
label,CommandDoc
value) -> [CommandDoc] -> CommandDoc
concatBottomPadded [CommandDoc -> CommandDoc -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
fmt1 CommandDoc
label, CommandDoc
value]) [(CommandDoc, CommandDoc)]
stats
    where
      fmt1 :: CommandDoc
fmt1 = CommandDoc
"%-" CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ Int -> CommandDoc
forall a. Show a => a -> CommandDoc
show Int
w1 CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
"s: "
      -- fmt2 = "%-" ++ show w2 ++ "s"
      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
$ ((CommandDoc, CommandDoc) -> Int)
-> [(CommandDoc, CommandDoc)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CommandDoc -> Int)
-> ((CommandDoc, CommandDoc) -> CommandDoc)
-> (CommandDoc, CommandDoc)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandDoc, CommandDoc) -> CommandDoc
forall a b. (a, b) -> a
fst) [(CommandDoc, CommandDoc)]
stats
      -- w2 = maximum $ map (length . show . snd) stats
      stats :: [(CommandDoc, CommandDoc)]
stats = [
         (CommandDoc
"Main file" :: String, CommandDoc
path) -- ++ " (from " ++ source ++ ")")
        ,(CommandDoc
"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)
        ,(CommandDoc
"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)
        ,(CommandDoc
"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)
        ,(CommandDoc
"Transactions", CommandDoc -> Int -> Double -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (%0.1f per day)" Int
tnum Double
txnrate)
        ,(CommandDoc
"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)
        ,(CommandDoc
"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)
        ,(CommandDoc
"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)
        ,(CommandDoc
"Accounts", CommandDoc -> Int -> Int -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (depth %d)" Int
acctnum Int
acctdepth)
        ,(CommandDoc
"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))
        ,(CommandDoc
"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
       ]
           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]
amounts (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
             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