{-|

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")
  [forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq  [CommandDoc
"output-file",CommandDoc
"o"]   (\CommandDoc
s RawOpts
opts -> forall a b. b -> Either a b
Right 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
  ([], forall a. a -> Maybe a
Just 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
      intervalspans :: [DateSpan]
intervalspans = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanBothDates Journal
j ReportSpec
rspec
      showstats :: DateSpan -> (Builder, Int)
showstats = Ledger -> Day -> DateSpan -> (Builder, Int)
showLedgerStats Ledger
l Day
today
      ([Builder]
ls, [Int]
txncounts) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> (Builder, Int)
showstats [DateSpan]
intervalspans
      numtxns :: Int
numtxns = 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 forall a b. (a -> b) -> a -> b
$ Builder -> Text
TB.toLazyText Builder
b
  POSIXTime
t <- IO POSIXTime
getPOSIXTime
  let dt :: POSIXTime
dt = POSIXTime
t forall a. Num a => a -> a -> a
- POSIXTime
progstarttime_
  forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"Run time (throughput)    : %.2fs (%.0f txns/s)\n" 
    (forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
dt :: Float) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numtxns forall a. Fractional a => a -> a -> a
/ 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
spn =
    ([Builder] -> Builder
unlinesB forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TableOpts -> Header Cell -> Builder
renderRowB forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False} forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, CommandDoc) -> Header Cell
showRow) [(Text, CommandDoc)]
stts
    ,Int
tnum)
  where
    showRow :: (Text, CommandDoc) -> Header Cell
showRow (Text
label, CommandDoc
val) = forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall h. h -> Header h
Header 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 (forall a. a -> Maybe a
Just Int
w1) (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
val]
    w1 :: Int
w1 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, CommandDoc)]
stts
    ([(Text, CommandDoc)]
stts, Int
tnum) = ([
       (Text
"Main file", CommandDoc
path) -- ++ " (from " ++ source ++ ")")
      ,(Text
"Included files", [CommandDoc] -> CommandDoc
unlines forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ Journal -> [CommandDoc]
journalFilePaths Journal
j)
      ,(Text
"Transactions span", forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s to %s (%d days)" (DateSpan -> CommandDoc
start DateSpan
spn) (DateSpan -> CommandDoc
end DateSpan
spn) Integer
days)
      ,(Text
"Last transaction", forall b a. b -> (a -> b) -> Maybe a -> b
maybe CommandDoc
"none" forall a. Show a => a -> CommandDoc
show Maybe Day
lastdate forall a. [a] -> [a] -> [a]
++ forall {a} {t}.
(IsString a, PrintfArg t, PrintfType a, Ord t, Num t) =>
Maybe t -> a
showelapsed Maybe Integer
lastelapsed)
      ,(Text
"Transactions", forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (%0.1f per day)" Int
tnum Double
txnrate)
      ,(Text
"Transactions last 30 days", forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (%0.1f per day)" Int
tnum30 Double
txnrate30)
      ,(Text
"Transactions last 7 days", forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (%0.1f per day)" Int
tnum7 Double
txnrate7)
      ,(Text
"Payees/descriptions", forall a. Show a => a -> CommandDoc
show forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> Int
size forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> Text
tdescription) [Transaction]
ts)
      ,(Text
"Accounts", forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%d (depth %d)" Int
acctnum Int
acctdepth)
      ,(Text
"Commodities", forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s (%s)" (forall a. Show a => a -> CommandDoc
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
cs) (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
cs))
      ,(Text
"Market prices", forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s (%s)" (forall a. Show a => a -> CommandDoc
show forall a b. (a -> b) -> a -> b
$ 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
tnum1)
       where
         j :: Journal
j = Ledger -> Journal
ljournal Ledger
l
         path :: CommandDoc
path = Journal -> CommandDoc
journalFilePath Journal
j
         ts :: [Transaction]
ts = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Transaction -> Day
tdate forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Day -> Bool
spanContainsDate DateSpan
spn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Day
tdate) forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
         as :: [Text]
as = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings [Transaction]
ts
         cs :: [Text]
cs = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. CommandDoc -> a
error' forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ [Amount] -> Either CommandDoc (Map Text AmountStyle)
commodityStylesFromAmounts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amountsRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings [Transaction]
ts  -- PARTIAL:
         lastdate :: Maybe Day
lastdate | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts = forall a. Maybe a
Nothing
                  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Transaction -> Day
tdate forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Transaction]
ts
         lastelapsed :: Maybe Integer
lastelapsed = 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 -> a
showelapsed Maybe t
Nothing = a
""
         showelapsed (Just t
dys) = forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
" (%d %s)" t
dys' CommandDoc
direction
                                   where dys' :: t
dys' = forall a. Num a => a -> a
abs t
dys
                                         direction :: CommandDoc
direction | t
dys forall a. Ord a => a -> a -> Bool
>= t
0 = CommandDoc
"days ago" :: String
                                                   | Bool
otherwise = CommandDoc
"days from now"
         tnum1 :: Int
tnum1 = 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
_) = forall a. Show a => a -> CommandDoc
show Day
d
         start DateSpan
_ = CommandDoc
""
         end :: DateSpan -> CommandDoc
end (DateSpan Maybe Day
_ (Just Day
d)) = forall a. Show a => a -> CommandDoc
show Day
d
         end DateSpan
_ = CommandDoc
""
         days :: Integer
days = forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Integer
daysInSpan DateSpan
spn
         txnrate :: Double
txnrate | Integer
daysforall a. Eq a => a -> a -> Bool
==Integer
0 = Double
0
                 | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tnum1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
days :: Double
         tnum30 :: Int
tnum30 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Transaction -> Bool
withinlast30 [Transaction]
ts
         withinlast30 :: Transaction -> Bool
withinlast30 Transaction
t = Day
d forall a. Ord a => a -> a -> Bool
>= Integer -> Day -> Day
addDays (-Integer
30) Day
today Bool -> Bool -> Bool
&& (Day
dforall a. Ord a => a -> a -> Bool
<=Day
today) where d :: Day
d = Transaction -> Day
tdate Transaction
t
         txnrate30 :: Double
txnrate30 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tnum30 forall a. Fractional a => a -> a -> a
/ Double
30 :: Double
         tnum7 :: Int
tnum7 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Transaction -> Bool
withinlast7 [Transaction]
ts
         withinlast7 :: Transaction -> Bool
withinlast7 Transaction
t = Day
d forall a. Ord a => a -> a -> Bool
>= Integer -> Day -> Day
addDays (-Integer
7) Day
today Bool -> Bool -> Bool
&& (Day
dforall a. Ord a => a -> a -> Bool
<=Day
today) where d :: Day
d = Transaction -> Day
tdate Transaction
t
         txnrate7 :: Double
txnrate7 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tnum7 forall a. Fractional a => a -> a -> a
/ Double
7 :: Double
         acctnum :: Int
acctnum = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
as
         acctdepth :: Int
acctdepth | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
as = Int
0
                   | Bool
otherwise = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
accountNameLevel [Text]
as
         mktprices :: [PriceDirective]
mktprices = Journal -> [PriceDirective]
jpricedirectives Journal
j
         mktpricecommodities :: [Text]
mktpricecommodities = forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> Text
pdcommodity [PriceDirective]
mktprices