1{-# LANGUAGE TemplateHaskell #-}
2
3{-|
4
5Print a bar chart of posting activity per day, or other report interval.
6
7-}
8
9module Hledger.Cli.Commands.Activity
10where
11
12import Data.List
13import Data.Maybe
14import Text.Printf
15
16import Hledger
17import Hledger.Cli.CliOptions
18import Prelude hiding (putStr)
19import Hledger.Utils.UTF8IOCompat (putStr)
20
21activitymode = hledgerCommandMode
22  $(embedFileRelative "Hledger/Cli/Commands/Activity.txt")
23  []
24  [generalflagsgroup1]
25  hiddenflags
26  ([], Just $ argsFlag "[QUERY]")
27
28barchar :: Char
29barchar = '*'
30
31-- | Print a bar chart of number of postings per report interval.
32activity :: CliOpts -> Journal -> IO ()
33activity CliOpts{reportopts_=ropts} j = do
34  d <- getCurrentDay
35  putStr $ showHistogram ropts (queryFromOpts d ropts) j
36
37showHistogram :: ReportOpts -> Query -> Journal -> String
38showHistogram opts q j = concatMap (printDayWith countBar) spanps
39    where
40      i = interval_ opts
41      interval | i == NoInterval = Days 1
42               | otherwise = i
43      span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j
44      spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span'
45      spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]
46      -- same as Register
47      -- should count transactions, not postings ?
48      -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
49      ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
50
51printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps)
52
53countBar ps = replicate (length ps) barchar
54