{-# 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 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]")
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: "
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
stats :: [(CommandDoc, CommandDoc)]
stats = [
(CommandDoc
"Main file" :: String, CommandDoc
path)
,(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))
]
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
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