{-# LANGUAGE TemplateHaskell #-}
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 = [Char]
-> [Flag RawOpts]
-> [([Char], [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Activity.txt")
[]
[([Char], [Flag RawOpts])]
cligeneralflagsgroups1
[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
$ [Char] -> Arg RawOpts
argsFlag [Char]
"[QUERY]")
barchar :: Char
barchar :: Char
barchar = Char
'*'
activity :: CliOpts -> Journal -> IO ()
activity :: CliOpts -> Journal -> IO ()
activity CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> [Char]
showHistogram ReportSpec
rspec Journal
j
showHistogram :: ReportSpec -> Journal -> String
showHistogram :: ReportSpec -> Journal -> [Char]
showHistogram rspec :: ReportSpec
rspec@ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
q} Journal
j =
(((Day, Day), [Posting]) -> [Char])
-> [((Day, Day), [Posting])] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Posting] -> [Char]) -> ((Day, Day), [Posting]) -> [Char]
forall {t} {t} {a} {t} {b}.
(PrintfArg t, PrintfType t, Show a) =>
(t -> t) -> ((a, b), t) -> t
printDayWith [Posting] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
countBar) [((Day, Day), [Posting])]
spanps
where
mspans :: Maybe (PeriodData Day)
mspans = (DateSpan, Maybe (PeriodData Day)) -> Maybe (PeriodData Day)
forall a b. (a, b) -> b
snd ((DateSpan, Maybe (PeriodData Day)) -> Maybe (PeriodData Day))
-> (ReportSpec -> (DateSpan, Maybe (PeriodData Day)))
-> ReportSpec
-> Maybe (PeriodData Day)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
reportSpan Journal
j (ReportSpec -> Maybe (PeriodData Day))
-> ReportSpec -> Maybe (PeriodData Day)
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
Lens' ReportSpec 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
Lens' ReportSpec Interval
interval (Int -> Interval
Days Int
1) ReportSpec
rspec
Interval
_ -> ReportSpec
rspec
spanps :: [((Day, Day), [Posting])]
spanps = case Maybe (PeriodData Day)
mspans of
Maybe (PeriodData Day)
Nothing -> []
Just PeriodData Day
x -> ((Day, Day) -> ((Day, Day), [Posting]))
-> [(Day, Day)] -> [((Day, Day), [Posting])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Day, Day)
spn -> ((Day, Day)
spn, (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Day, Day) -> Posting -> Bool
postingInRange (Day, Day)
spn) [Posting]
ps)) ([(Day, Day)] -> [((Day, Day), [Posting])])
-> ((Day, [(Day, Day)]) -> [(Day, Day)])
-> (Day, [(Day, Day)])
-> [((Day, Day), [Posting])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day, [(Day, Day)]) -> [(Day, Day)]
forall a b. (a, b) -> b
snd ((Day, [(Day, Day)]) -> [((Day, Day), [Posting])])
-> (Day, [(Day, Day)]) -> [((Day, Day), [Posting])]
forall a b. (a -> b) -> a -> b
$ PeriodData Day -> (Day, [(Day, Day)])
forall a. PeriodData a -> (a, [(Day, a)])
periodDataToList PeriodData Day
x
postingInRange :: (Day, Day) -> Posting -> Bool
postingInRange (Day
b, Day
e) Posting
p = Posting -> Day
postingDate Posting
p Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
b Bool -> Bool -> Bool
&& Posting -> Day
postingDate Posting
p Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
e
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) -> ((a, b), t) -> t
printDayWith t -> t
f ((a
b, b
_), t
ps) = [Char] -> [Char] -> t -> t
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s %s\n" (a -> [Char]
forall a. Show a => a -> [Char]
show a
b) (t -> t
f t
ps)
countBar :: t a -> [Char]
countBar t a
ps = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ps) Char
barchar