Add chart-request date filtering

examples/chart-requests.toml

@@ -13,7 +13,7 @@ unit = "mi"
 # Only takes runs with label 'marathon'
 [[charts]]
 title = 'Marathons'
-filters = ['label marathon']
+filters = ['label marathon', 'date >= 2024']
 y-axis = 'duration'
 y1-axis = 'pace'
 

pacer.cabal

@@ -32,9 +32,11 @@ source-repository head
 common common-lang
   default-extensions:
     ApplicativeDo
+    DeriveAnyClass
     DerivingVia
     DuplicateRecordFields
     LexicalNegation
+    MultiWayIf
     NoImplicitPrelude
     OverloadedRecordDot
     OverloadedStrings
@@ -71,6 +73,7 @@ library
     Pacer.Command.Chart.Data.ChartOptions
     Pacer.Command.Chart.Data.ChartRequest
     Pacer.Command.Chart.Data.Run
+    Pacer.Command.Chart.Data.Time
     Pacer.Command.Chart.Params
     Pacer.Command.Convert
     Pacer.Command.Convert.Args
@@ -108,6 +111,7 @@ library
     , base                             >=4.20.0.0 && <4.22
     , bytestring                       >=0.10.12  && <0.13
     , containers                       >=0.6.3.1  && <0.8
+    , deepseq                          >=1.4.6.0  && <1.6
     , effectful                        ^>=2.5.0.0
     , exception-utils                  ^>=0.1
     , exceptions                       ^>=0.10.4
@@ -156,6 +160,7 @@ test-suite unit
     Unit.Pacer.Command.Chart
     Unit.Pacer.Command.Chart.Data.ChartRequest
     Unit.Pacer.Command.Chart.Data.Run
+    Unit.Pacer.Command.Chart.Data.Time
     Unit.Pacer.Command.Chart.Params
     Unit.Pacer.Command.Derive
     Unit.Pacer.Data.Distance
@@ -181,8 +186,10 @@ test-suite unit
     , tasty-hunit                      >=0.9      && <0.11
     , terminal-effectful
     , text
+    , time
     , toml-reader
     , typed-process-dynamic-effectful
+    , tz                               ^>=0.1.3.3
 
   hs-source-dirs: test/unit
   ghc-options:    -threaded -with-rtsopts=-N

src/Pacer/Class/Parser.hs

@@ -24,9 +24,12 @@ where
 
 import Data.Char qualified as Ch
 import Data.Text qualified as T
+import Data.Time.Format qualified as Format
 import Data.Time.Relative qualified as Rel
+import Data.Word (Word16)
 import Numeric.Data.Fraction.Algebra (mkFraction)
 import Pacer.Prelude
+import Pacer.Utils (EitherString (EitherLeft, EitherRight))
 import Text.Megaparsec (Parsec, (<?>))
 import Text.Megaparsec qualified as MP
 import Text.Read qualified as TR
@@ -39,6 +42,9 @@ class Parser a where
   -- | Megaparsec parser for the given type.
   parser :: MParser a
 
+instance Parser Word16 where
+  parser = parseIntegral
+
 instance Parser Double where
   parser = parseDigits
 
@@ -69,14 +75,70 @@ instance (AMonoid a, Ord a, Parser a, Show a) => Parser (Positive a) where
       Nothing -> fail $ "Parsed non-positive: " ++ show d
       Just x -> pure x
 
+instance Parser LocalTime where
+  parser = do
+    str <- unpackText <$> MP.takeWhile1P Nothing (\c -> Ch.isDigit c || c == '-')
+    case Format.parseTimeM False Format.defaultTimeLocale fmt str of
+      EitherRight d -> pure d
+      EitherLeft err ->
+        fail
+          $ mconcat
+            [ "Failed parsing localtime from string '",
+              str,
+              "': ",
+              err
+            ]
+    where
+      fmt = "%Y-%m-%dT%H:%M:%S"
+
+instance Parser ZonedTime where
+  parser = do
+    str <- unpackText <$> MP.takeWhile1P Nothing (\c -> Ch.isDigit c || c == '-')
+    case Format.parseTimeM False Format.defaultTimeLocale fmt str of
+      EitherRight d -> pure d
+      EitherLeft err ->
+        fail
+          $ mconcat
+            [ "Failed parsing zoned time from string '",
+              str,
+              "': ",
+              err
+            ]
+    where
+      fmt = "%Y-%m-%dT%H:%M:%S%z"
+
+instance Parser Day where
+  parser = do
+    str <- unpackText <$> MP.takeWhile1P Nothing (\c -> Ch.isDigit c || c == '-')
+    case Format.parseTimeM False Format.defaultTimeLocale fmt str of
+      EitherRight d -> pure d
+      EitherLeft err ->
+        fail
+          $ mconcat
+            [ "Failed parsing day from string '",
+              str,
+              "': ",
+              err
+            ]
+    where
+      fmt = "%Y-%m-%d"
+
 -- | Parser combinator for digits with a 'Read' instance.
 parseDigits :: (Read n) => Parsec Void Text n
 parseDigits = parseDigitText >>= readDigits
 
+-- | Parser combinator for digits with a 'Read' instance.
+parseIntegral :: (Read n) => Parsec Void Text n
+parseIntegral = parseIntegralText >>= readDigits
+
 -- | Parser combinator for digits.
 parseDigitText :: Parsec Void Text Text
 parseDigitText =
-  MP.takeWhile1P Nothing (\c -> Ch.isDigit c || c == '.')
+  MP.takeWhile1P (Just "parseDigitText") (\c -> Ch.isDigit c || c == '.')
+
+-- | Parser combinator for digits.
+parseIntegralText :: Parsec Void Text Text
+parseIntegralText = MP.takeWhile1P (Just "parseIntegralText") Ch.isDigit
 
 -- | Read text like "1d2h3m4s", parse w/ relative time into Fractional
 -- seconds.

src/Pacer/Command/Chart/Data/ChartData.hs

@@ -18,7 +18,7 @@ import Pacer.Command.Chart.Data.ChartRequest
     ChartRequests (unChartRequests),
     FilterExpr,
     FilterOp (MkFilterOp),
-    FilterType (FilterDistance, FilterDuration, FilterLabel, FilterPace),
+    FilterType (FilterDate, FilterDistance, FilterDuration, FilterLabel, FilterPace),
     YAxisType
       ( YAxisDistance,
         YAxisDuration,
@@ -28,12 +28,12 @@ import Pacer.Command.Chart.Data.ChartRequest
   )
 import Pacer.Command.Chart.Data.Run
   ( Run (datetime, distance, duration),
-    RunTimestamp,
     SomeRun (MkSomeRun),
     SomeRuns (MkSomeRuns),
     SomeRunsKey (MkSomeRunsKey, unSomeRunsKey),
   )
 import Pacer.Command.Chart.Data.Run qualified as Run
+import Pacer.Command.Chart.Data.Time (Moment (MomentTimestamp), Timestamp)
 import Pacer.Data.Distance (Distance (unDistance), SomeDistance)
 import Pacer.Data.Distance.Units
   ( DistanceUnit (Kilometer, Meter, Mile),
@@ -57,7 +57,7 @@ instance ToJSON ChartData where
 -- | Data for a chart with a single Y axis.
 data ChartY = MkChartY
   { -- | X and Y axis data.
-    values :: NESeq (Tuple2 RunTimestamp Double),
+    values :: NESeq (Tuple2 Timestamp Double),
     -- | Y axis type. This is used for the label on the line itself, __not__
     -- the y-axis (that label is on ChartOptions).
     yType :: YAxisType
@@ -78,7 +78,7 @@ instance ToJSON ChartY where
 -- | Data for a chart with two Y axes.
 data ChartY1 = MkChartY1
   { -- | Data for a chart with two y Axes.
-    values :: NESeq (Tuple3 RunTimestamp Double Double),
+    values :: NESeq (Tuple3 Timestamp Double Double),
     -- | Type of first Y axis.
     yType :: YAxisType,
     -- | Type of second Y axis.
@@ -109,10 +109,10 @@ mkYJson yVal yType yId =
     ]
 
 -- | Accumulator for chart with a single Y axis.
-type AccY = NESeq (Tuple2 RunTimestamp Double)
+type AccY = NESeq (Tuple2 Timestamp Double)
 
 -- | Accumulator for chart with two Y axes.
-type AccY1 = NESeq (Tuple3 RunTimestamp Double Double)
+type AccY1 = NESeq (Tuple3 Timestamp Double Double)
 
 -- | Turns a sequence of runs and chart requests into charts.
 mkChartDatas ::
@@ -224,13 +224,19 @@ filterRuns rs filters = (.unSomeRunsKey) <$> NESeq.filter filterRun rs
 
     applyFilter :: SomeRunsKey a -> FilterType a -> Bool
     applyFilter srk (FilterLabel lbl) = applyLabel srk.unSomeRunsKey lbl
+    applyFilter srk (FilterDate op m) = applyDate srk.unSomeRunsKey op m
     applyFilter srk (FilterDistance op d) = applyDist srk.unSomeRunsKey op d
     applyFilter srk (FilterDuration op d) = applyDur srk.unSomeRunsKey op d
     applyFilter srk (FilterPace op p) = applyPace srk.unSomeRunsKey op p
 
     applyLabel :: SomeRun a -> Text -> Bool
     applyLabel (MkSomeRun _ r) lbl = lbl `elem` r.labels
 
+    applyDate :: SomeRun a -> FilterOp -> Moment -> Bool
+    applyDate (MkSomeRun _ r) op m = (opToFun op) runMoment m
+      where
+        runMoment = MomentTimestamp r.datetime
+
     applyDist :: SomeRun a -> FilterOp -> SomeDistance (Positive a) -> Bool
     applyDist (MkSomeRun @runDist sr r) op fDist =
       withSingI sr $ (opToFun op) r.distance fDist'

src/Pacer/Command/Chart/Data/ChartRequest.hs

@@ -21,6 +21,7 @@ import Data.Aeson (ToJSON)
 import Data.Aeson.Types (ToJSON (toJSON))
 import Pacer.Class.Parser (Parser (parser))
 import Pacer.Class.Parser qualified as P
+import Pacer.Command.Chart.Data.Time (Moment)
 import Pacer.Data.Distance (DistanceUnit, SomeDistance)
 import Pacer.Data.Duration (Seconds)
 import Pacer.Data.Pace (SomePace)
@@ -82,10 +83,11 @@ instance Parser FilterOp where
 
 -- | Ways in which we can filter runs.
 data FilterType a
-  = -- | Filters by label equality.
-    FilterLabel Text
-  | FilterDistance FilterOp (SomeDistance (Positive a))
+  = FilterDistance FilterOp (SomeDistance (Positive a))
   | FilterDuration FilterOp (Seconds (Positive a))
+  | -- | Filters by label equality.
+    FilterLabel Text
+  | FilterDate FilterOp Moment
   | FilterPace FilterOp (SomePace (Positive a))
   deriving stock (Eq, Show)
 
@@ -103,13 +105,22 @@ instance
       [ parseLabel,
         parseDist,
         parseDuration,
-        parsePace
+        parsePace,
+        parseDate
       ]
     where
       parseLabel = do
         void $ MPC.string "label "
         FilterLabel <$> MP.takeWhile1P Nothing (/= ')')
 
+      parseDate = do
+        MPC.string "date"
+        MPC.space1
+        op <- parser
+        MPC.space1
+        m <- parser
+        pure $ FilterDate op m
+
       parseDist = parsePred "distance" FilterDistance
       parseDuration = parsePred "duration" FilterDuration
       parsePace = parsePred "pace" FilterPace