{-# LANGUAGE TemplateHaskell #-}

{-|

Print a bar chart of posting activity per day, or other report interval.

-}

module Hledger.Cli.Commands.Activity
where

import Data.List (sortOn)
import Text.Printf (printf)
import Lens.Micro ((^.), set)

import Hledger
import Hledger.Cli.CliOptions

activitymode :: Mode RawOpts
activitymode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Activity.txt")
  []
  [(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]")

barchar :: Char
barchar :: Char
barchar = Char
'*'

-- | Print a bar chart of number of postings per report interval.
activity :: CliOpts -> Journal -> IO ()
activity :: CliOpts -> Journal -> IO ()
activity CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = CommandDoc -> IO ()
putStr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> CommandDoc
showHistogram ReportSpec
rspec Journal
j

showHistogram :: ReportSpec -> Journal -> String
showHistogram :: ReportSpec -> Journal -> CommandDoc
showHistogram rspec :: ReportSpec
rspec@ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
q} Journal
j =
    ((DateSpan, [Posting]) -> CommandDoc)
-> [(DateSpan, [Posting])] -> CommandDoc
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Posting] -> CommandDoc) -> (DateSpan, [Posting]) -> CommandDoc
forall t p t.
(PrintfArg t, PrintfType p) =>
(t -> t) -> (DateSpan, t) -> p
printDayWith [Posting] -> CommandDoc
forall (t :: * -> *) a. Foldable t => t a -> CommandDoc
countBar) [(DateSpan, [Posting])]
spanps
  where
    spans :: [DateSpan]
spans = (DateSpan -> Bool) -> [DateSpan] -> [DateSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing DateSpan -> DateSpan -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([DateSpan] -> [DateSpan])
-> (ReportSpec -> [DateSpan]) -> ReportSpec -> [DateSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateSpan, [DateSpan]) -> [DateSpan]
forall a b. (a, b) -> b
snd ((DateSpan, [DateSpan]) -> [DateSpan])
-> (ReportSpec -> (DateSpan, [DateSpan]))
-> ReportSpec
-> [DateSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan Journal
j (ReportSpec -> [DateSpan]) -> ReportSpec -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ case ReportSpec
rspec ReportSpec -> Getting Interval ReportSpec Interval -> Interval
forall s a. s -> Getting a s a -> a
^. Getting Interval ReportSpec Interval
forall c. HasReportOptsNoUpdate c => Lens' c Interval
interval of
      Interval
NoInterval -> ASetter ReportSpec ReportSpec Interval Interval
-> Interval -> ReportSpec -> ReportSpec
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ReportSpec ReportSpec Interval Interval
forall c. HasReportOptsNoUpdate c => Lens' c Interval
interval (Int -> Interval
Days Int
1) ReportSpec
rspec
      Interval
_ -> ReportSpec
rspec
    spanps :: [(DateSpan, [Posting])]
spanps = [(DateSpan
s, (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Posting -> Bool
isPostingInDateSpan DateSpan
s) [Posting]
ps) | DateSpan
s <- [DateSpan]
spans]
    -- same as Register
    -- should count transactions, not postings ?
    -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
    ps :: [Posting]
ps = (Posting -> Day) -> [Posting] -> [Posting]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> Day
postingDate ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Posting -> Bool
`matchesPosting`) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j

printDayWith :: (t -> t) -> (DateSpan, t) -> p
printDayWith t -> t
f (DateSpan (Just Day
b) Maybe Day
_, t
ps) = CommandDoc -> CommandDoc -> t -> p
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s %s\n" (Day -> CommandDoc
forall a. Show a => a -> CommandDoc
show Day
b) (t -> t
f t
ps)
printDayWith t -> t
_ (DateSpan, t)
_ = CommandDoc -> p
forall a. HasCallStack => CommandDoc -> a
error CommandDoc
"Expected start date for DateSpan"  -- PARTIAL:

countBar :: t a -> CommandDoc
countBar t a
ps = Int -> Char -> CommandDoc
forall a. Int -> a -> [a]
replicate (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ps) Char
barchar