{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Activity
where
import Data.List
import Data.Maybe
import Text.Printf
import Hledger
import Hledger.Cli.CliOptions
import Prelude hiding (putStr)
import Hledger.Utils.UTF8IOCompat (putStr)
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 "[QUERY]")
barchar :: Char
barchar :: Char
barchar = '*'
activity :: CliOpts -> Journal -> IO ()
activity :: CliOpts -> Journal -> IO ()
activity CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
Day
d <- IO Day
getCurrentDay
CommandDoc -> IO ()
putStr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query -> Journal -> CommandDoc
showHistogram ReportOpts
ropts (Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts) Journal
j
showHistogram :: ReportOpts -> Query -> Journal -> String
showHistogram :: ReportOpts -> Query -> Journal -> CommandDoc
showHistogram opts :: ReportOpts
opts q :: Query
q j :: 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 t t.
(PrintfArg t, PrintfType t) =>
(t -> t) -> (DateSpan, t) -> t
printDayWith [Posting] -> CommandDoc
forall (t :: * -> *) a. Foldable t => t a -> CommandDoc
countBar) [(DateSpan, [Posting])]
spanps
where
i :: Interval
i = ReportOpts -> Interval
interval_ ReportOpts
opts
interval :: Interval
interval | Interval
i Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
== Interval
NoInterval = Int -> Interval
Days 1
| Bool
otherwise = Interval
i
span' :: DateSpan
span' = Bool -> Query -> DateSpan
queryDateSpan (ReportOpts -> Bool
date2_ ReportOpts
opts) Query
q DateSpan -> DateSpan -> DateSpan
`spanDefaultsFrom` Bool -> Journal -> DateSpan
journalDateSpan (ReportOpts -> Bool
date2_ ReportOpts
opts) Journal
j
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]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Interval -> DateSpan -> [DateSpan]
splitSpan Interval
interval DateSpan
span'
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]
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) -> t
printDayWith f :: t -> t
f (DateSpan b :: Maybe Day
b _, ps :: t
ps) = CommandDoc -> CommandDoc -> t -> t
forall r. PrintfType r => CommandDoc -> r
printf "%s %s\n" (Day -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Day -> CommandDoc) -> Day -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Day
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Day
b) (t -> t
f t
ps)
countBar :: t a -> CommandDoc
countBar ps :: 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