Add file decoding benchmarks

.github/workflows/ci.yaml

@@ -5,6 +5,7 @@ on: # yamllint disable-line rule:truthy rule:comments
   push:
     branches:
       - main
+      - bench
 
   pull_request:
     branches:
@@ -69,6 +70,27 @@ jobs:
           # Let's test it overwrites successfully
           cabal run pacer ${{ matrix.ghc.proj_file }} -- chart --data examples
 
+      - name: Benchmarks
+        if: ${{ matrix.os == 'ubuntu-latest' }}
+        id: bench
+        run: |
+          cabal bench ${{ matrix.ghc.proj_file }} --benchmark-options '
+            +RTS -T -RTS
+            -t100
+            --csv bench/${{ matrix.os }}_${{ matrix.ghc.vers }}_ci.csv
+            --svg bench/${{ matrix.os }}_${{ matrix.ghc.vers }}_ci.svg
+            --baseline bench/baseline_${{ matrix.os }}_${{ matrix.ghc.vers }}_ci.csv
+            --fail-if-slower 1
+            --fail-if-faster 1'
+
+      - uses: actions/upload-artifact@v4
+        if: ${{ failure() && steps.bench.conclusion == 'failure' }}
+        with:
+          name: build-artifacts
+          path: |
+            bench/${{ matrix.os }}_${{ matrix.ghc.vers }}_ci.csv
+            bench/${{ matrix.os }}_${{ matrix.ghc.vers }}_ci.svg
+
   stack:
     strategy:
       fail-fast: false

bench/Main.hs

@@ -0,0 +1,247 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Main (main) where
+
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as C8
+import Data.List qualified as L
+import Data.Time (LocalTime (LocalTime), ZonedTime (ZonedTime))
+import Data.Time.Calendar qualified as Cal
+import Effectful.FileSystem.FileReader.Dynamic qualified as FRD
+import Effectful.FileSystem.FileWriter.Static qualified as FW
+import Effectful.FileSystem.PathReader.Static qualified as PR
+import Effectful.FileSystem.PathWriter.Static qualified as PW
+import Effectful.Logger.Dynamic (Logger (LoggerLog))
+import FileSystem.OsPath (decodeLenient)
+import FileSystem.Path qualified as Path
+import Pacer.Class.Parser (Parser)
+import Pacer.Class.Parser qualified as P
+import Pacer.Command.Chart (ChartPaths)
+import Pacer.Command.Chart qualified as Chart
+import Pacer.Command.Chart.Data.ChartRequest (ChartRequests)
+import Pacer.Command.Chart.Data.Run (SomeRuns)
+import Pacer.Command.Chart.Data.Time
+  ( Timestamp
+      ( TimestampDate,
+        TimestampTime,
+        TimestampZoned
+      ),
+  )
+import Pacer.Command.Chart.Data.Time qualified as Time
+import Pacer.Prelude hiding (IO)
+import System.Environment.Guard (ExpectEnv (ExpectEnvSet), guardOrElse')
+import System.IO qualified as IO
+import Test.Tasty.Bench
+  ( Benchmark,
+    bench,
+    bgroup,
+    defaultMain,
+    nfIO,
+  )
+import Prelude (IO)
+
+main :: IO ()
+main = bracket setup teardown runBenchmarks
+  where
+    runBenchmarks testParams =
+      defaultMain
+        [ benchReadInputs testParams
+        ]
+
+benchReadInputs :: TestParams -> Benchmark
+benchReadInputs params =
+  bgroup
+    "readChartInputs"
+    [ bench "100" . nfIO $ benchRead (mkPaths params.runs_100_path),
+      bench "1_000" . nfIO $ benchRead (mkPaths params.runs_1_000_path),
+      bench "10_000" . nfIO $ benchRead (mkPaths params.runs_10_000_path)
+    ]
+  where
+    mkPaths r =
+      ( params.chartRequestsPath,
+        Nothing,
+        r :| []
+      )
+
+benchRead :: ChartPaths -> IO (Tuple2 (ChartRequests Double) (SomeRuns Double))
+benchRead = runRead . Chart.readChartInputs
+  where
+    runRead =
+      runEff
+        . runLoggerNS "bench"
+        . runLoggerMock
+        . FRD.runFileReader
+
+    runLoggerMock :: Eff (Logger : es) a -> Eff es a
+    runLoggerMock = interpret_ $ \case
+      LoggerLog {} -> pure ()
+
+data TestParams = MkTestParams
+  { testDir :: Path Abs Dir,
+    chartRequestsPath :: Path Abs File,
+    runs_100_path :: Path Abs File,
+    runs_1_000_path :: Path Abs File,
+    runs_10_000_path :: Path Abs File
+  }
+
+setup :: IO TestParams
+setup = runner $ do
+  testDirOsPath <-
+    (\tmp -> tmp </> [ospPathSep|pacer/bench|])
+      <$> PR.getTemporaryDirectory
+  PW.createDirectoryIfMissing True testDirOsPath
+
+  testDir <- Path.parseAbsDir testDirOsPath
+
+  let chartRequestsPath = testDir <</>> [relfile|chart-requests.json|]
+      runs_100_path = testDir <</>> [relfile|runs_100.json|]
+      runs_1_000_path = testDir <</>> [relfile|runs_1_000.json|]
+      runs_10_000_path = testDir <</>> [relfile|runs_10_000.json|]
+
+      runs_100 = genRunsJson 100
+      runs_1_000 = genRunsJson 1_000
+      runs_10_000 = genRunsJson 10_000
+
+  FW.writeBinaryFile (pathToOsPath chartRequestsPath) genChartRequestsJson
+  FW.writeBinaryFile (pathToOsPath runs_100_path) runs_100
+  FW.writeBinaryFile (pathToOsPath runs_1_000_path) runs_1_000
+  FW.writeBinaryFile (pathToOsPath runs_10_000_path) runs_10_000
+
+  pure
+    $ MkTestParams
+      { testDir,
+        chartRequestsPath,
+        runs_100_path,
+        runs_1_000_path,
+        runs_10_000_path
+      }
+
+genRunsJson :: Integer -> ByteString
+genRunsJson maxAll = mkBS allRuns
+  where
+    -- NOTE: [Avoiding overlaps]
+    --
+    -- Our runs creation is fairly simple. For each of Date, Time, Zoned
+    -- types, given a start date, create a sequence of runs by where each
+    -- run is the previous run + 1 day.
+    --
+    -- Because we interlace all of Date, Time, Zoned, the easiest way to
+    -- avoid overlaps is to choose a start date for each s.t. the ranges will
+    -- not overlap at all.
+    --
+    -- The current max runs is 10_000, so each range is 10_000 / 3 = 3,333
+    -- days ~ 9 years.
+    --
+    -- Thus if we space out each start date by 10 years, we should be fine.
+    maxEach = maxAll .%. 3
+
+    allRuns :: List ByteString
+    allRuns =
+      join
+        -- zipWith3 so that we can interleave the different times, just so the
+        -- sorting is non-trivial.
+        $ L.zipWith3
+          (\d t z -> mkRun d : mkRun t : [mkRun z])
+          dates
+          times
+          zoneds
+
+    mkRun :: Timestamp -> ByteString
+    mkRun t =
+      -- intercalate over unlines so we don't have a trailing newline
+      BS.intercalate
+        "\n"
+        [ "    {",
+          "      \"datetime\": \"" <> encodeTimestamp t <> "\",",
+          "      \"distance\": \"marathon\",",
+          "      \"duration\": \"3h20m\"",
+          "    }"
+        ]
+
+    mkBS :: List ByteString -> ByteString
+    mkBS rs =
+      C8.unlines
+        [ "{",
+          "  \"runs\": [",
+          BS.intercalate ",\n" rs,
+          "  ]",
+          "}"
+        ]
+
+    -- See NOTE: [Avoiding overlaps] for choosing good start dates for each
+    -- 3 types.
+    startDate :: Day
+    startDate = unsafeParse "1990-04-08"
+
+    dates :: List Timestamp
+    dates = (TimestampDate . incDate startDate) <$> [0 .. maxEach]
+
+    startTime :: LocalTime
+    startTime = unsafeParse "2000-04-08T12:00:00"
+
+    times :: List Timestamp
+    times = (TimestampTime . incTime startTime) <$> [0 .. maxEach]
+
+    startZoned :: ZonedTime
+    startZoned = unsafeParse "2010-04-08T12:00:00-0800"
+
+    zoneds :: List Timestamp
+    zoneds = (TimestampZoned . incZoned startZoned) <$> [0 .. maxEach]
+
+    encodeTimestamp :: Timestamp -> ByteString
+    encodeTimestamp = encodeUtf8 . Time.fmtTimestamp
+
+    incDate :: Day -> Integer -> Day
+    incDate d i = Cal.addDays i d
+
+    incTime :: LocalTime -> Integer -> LocalTime
+    incTime (LocalTime d t) i = LocalTime (incDate d i) t
+
+    incZoned :: ZonedTime -> Integer -> ZonedTime
+    incZoned (ZonedTime (LocalTime d t) z) i =
+      ZonedTime (LocalTime (incDate d i) t) z
+
+    unsafeParse :: (Parser a) => Text -> a
+    unsafeParse = errorErr . P.parseAll
+
+genChartRequestsJson :: ByteString
+genChartRequestsJson =
+  C8.unlines
+    [ "{",
+      "  \"garmin\": {",
+      "    \"unit\": \"km\"",
+      "  },",
+      "  \"charts\": [",
+      "    {",
+      "      \"title\": \"Some chart\",",
+      "      \"y-axis\": \"distance\"",
+      "    }",
+      "  ]",
+      "}"
+    ]
+
+teardown :: TestParams -> IO ()
+teardown params = guardOrElse' "NO_CLEANUP" ExpectEnvSet doNothing cleanup
+  where
+    cleanup = runner $ PW.removePathForcibly testDirOsPath
+    doNothing =
+      IO.putStrLn
+        $ "*** Not cleaning up tmp dir: '"
+        <> decodeLenient testDirOsPath
+        <> "'"
+    testDirOsPath = pathToOsPath params.testDir
+
+runner ::
+  Eff
+    [ FW.FileWriter,
+      PW.PathWriter,
+      PR.PathReader,
+      IOE
+    ]
+    a ->
+  IO a
+runner =
+  runEff
+    . PR.runPathReader
+    . PW.runPathWriter
+    . FW.runFileWriter

bench/baseline_9.10.1.csv

@@ -0,0 +1,4 @@
+Name,Mean (ps),2*Stdev (ps),Allocated,Copied,Peak Memory
+All.readChartInputs.100,3521228150,201876744,7624575,178406,15728640
+All.readChartInputs.1_000,62961234100,1907407574,183550980,3390282,15728640
+All.readChartInputs.10_000,4974078999850,1317383715584,12469905136,40740313,38797312

bench/baseline_ubuntu-latest_9.10.1_ci.csv

@@ -0,0 +1,4 @@
+Name,Mean (ps),2*Stdev (ps),Allocated,Copied,Peak Memory
+All.readChartInputs.100,3521228150,201876744,7624575,178406,15728640
+All.readChartInputs.1_000,62961234100,1907407574,183550980,3390282,15728640
+All.readChartInputs.10_000,4974078999850,1317383715584,12469905136,40740313,38797312

bench/baseline_ubuntu-latest_9.12.1_ci.csv

@@ -0,0 +1,4 @@
+Name,Mean (ps),2*Stdev (ps),Allocated,Copied,Peak Memory
+All.readChartInputs.100,3521228150,201876744,7624575,178406,15728640
+All.readChartInputs.1_000,62961234100,1907407574,183550980,3390282,15728640
+All.readChartInputs.10_000,4974078999850,1317383715584,12469905136,40740313,38797312