Initial chart generation and tests

.github/workflows/ci.yaml

@@ -29,57 +29,35 @@ jobs:
     steps:
       - uses: actions/checkout@v4
 
-      - uses: haskell-actions/setup@v2
+      - name: Setup haskell
+        uses: haskell-actions/setup@v2
         with:
           ghc-version: ${{ matrix.ghc }}
 
-      - name: Configure
+      - name: Setup node
+        uses: actions/setup-node@v4
+        with:
+          node-version: 23.x
+
+      - name: Configure backend
         run: cabal configure --enable-tests --ghc-options -Werror
 
-      - name: Compile
+      - name: Compile backend
         run: cabal build pacer
 
-      - name: Unit tests
+      - name: Backend Unit tests
         run: cabal test pacer:unit --test-options '--hedgehog-tests 1000000'
 
-      - name: Functional tests
+      - name: Backend functional tests
         run: cabal test pacer:functional
-  nix:
-    strategy:
-      fail-fast: false
-      matrix:
-        os:
-          - "macos-latest"
-          - "ubuntu-latest"
-    runs-on: ${{ matrix.os }}
-    steps:
-      - uses: actions/checkout@v4
 
-      - name: Setup nix
-        uses: cachix/install-nix-action@v25
-        with:
-          github_access_token: ${{ secrets.GITHUB_TOKEN }}
-          nix_path: nixpkgs=channel:nixos-unstable
-
-      - name: Compile & Test
-        run: nix build
-  web:
-    strategy:
-      fail-fast: false
-      matrix:
-        os:
-          - "macos-latest"
-          - "ubuntu-latest"
-    runs-on: ${{ matrix.os }}
-    steps:
-      - uses: actions/checkout@v4
-
-      - name: Setup node
-        uses: actions/setup-node@v4
-        with:
-          node-version: 23.x
+      - name: Generate charts json with backend
+        run: |
+          cabal run pacer -- chart \
+            --runs backend/data/input/example/runs.toml \
+            --chart-requests backend/data/input/example/chart-requests.toml
 
-      - name: Install dependencies
+      - name: Install web dependencies
         run: |
           cd web
           npm install

.gitignore

@@ -9,5 +9,6 @@ cabal.project.local
 /result
 
 # web
+/web/data/input/charts.json
 /web/dist
 /web/node_modules

backend/pacer.cabal

@@ -41,6 +41,7 @@ library
   other-modules:   Paths_pacer
   autogen-modules: Paths_pacer
   exposed-modules:
+    Pacer.Chart
     Pacer.Chart.Data.Chart
     Pacer.Chart.Data.ChartRequest
     Pacer.Chart.Data.Run
@@ -61,23 +62,26 @@ library
     Pacer.Utils
 
   build-depends:
-    , aeson                 >=2.0      && <2.3
+    , aeson                 >=2.0       && <2.3
+    , aeson-pretty          ^>=0.8.9
     , algebra-simple        ^>=0.1
-    , base                  >=4.14.0.0 && <4.21
-    , bytestring            >=0.10.12  && <0.13
-    , containers            >=0.6.3.1  && <0.8
+    , base                  >=4.14.0.0  && <4.21
+    , bytestring            >=0.10.12   && <0.13
+    , containers            >=0.6.3.1   && <0.8
+    , directory             ^>=1.3.8.0
     , exception-utils       ^>=0.1
+    , filepath              >=1.4.100.1 && <1.6
     , fs-utils              ^>=0.1
-    , megaparsec            >=7.0.5    && <9.7
-    , nonempty-containers   >=0.3.4.2  && <0.4
-    , optparse-applicative  >=0.15     && <0.19
+    , megaparsec            >=7.0.5     && <9.7
+    , nonempty-containers   >=0.3.4.2   && <0.4
+    , optparse-applicative  >=0.15      && <0.19
     , relative-time         ^>=0.1
     , singletons            ^>=3.0.3
     , smart-math            ^>=0.1
-    , text                  >=1.2.3.2  && <2.2
-    , text-display          >=0.0.3.0  && <0.6
-    , time                  >=1.9.3    && <1.15
-    , toml-reader           >=0.2.0.0  && <0.3.0.0
+    , text                  >=1.2.3.2   && <2.2
+    , text-display          >=0.0.3.0   && <0.6
+    , time                  >=1.9.3     && <1.15
+    , toml-reader           >=0.2.0.0   && <0.3.0.0
 
   -- tuple syntax
   if impl(ghc >=9.10.1)
@@ -128,15 +132,18 @@ test-suite functional
   type:           exitcode-stdio-1.0
   main-is:        Main.hs
   other-modules:
+    Functional.Chart
     Functional.Derive
     Functional.Prelude
     Functional.Scale
 
   build-depends:
     , base
+    , fs-utils
     , hedgehog
     , pacer
     , tasty
+    , tasty-golden    ^>=2.3.1.1
     , tasty-hedgehog
     , tasty-hunit
 

backend/src/Pacer/Chart.hs

@@ -0,0 +1,143 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Pacer.Chart
+  ( -- * Params
+    ChartParams (..),
+    ChartPhase (..),
+    ChartParamsArgs,
+    ChartParamsFinal,
+    advancePhase,
+
+    -- * Functions
+    createChartsJsonFile,
+    createChartsJsonBS,
+
+    -- * Default paths
+    defChartRequestsPath,
+    defRunsPath,
+    defOutJsonPath,
+  )
+where
+
+import Data.Aeson.Encode.Pretty
+  ( Config (confIndent, confTrailingNewline),
+    Indent (Spaces),
+  )
+import Data.Aeson.Encode.Pretty qualified as AsnPretty
+import Pacer.Chart.Data.Chart (Chart)
+import Pacer.Chart.Data.Chart qualified as Chart
+import Pacer.Chart.Data.ChartRequest (ChartRequests)
+import Pacer.Chart.Data.Run (SomeRuns)
+import Pacer.Prelude
+import System.Directory.OsPath qualified as Dir
+import System.OsPath qualified as OsPath
+import TOML (DecodeTOML, decode)
+
+-- | Phase for 'ChartParams'.
+data ChartPhase
+  = ChartArgs
+  | ChartFinal
+  deriving stock (Eq, Show)
+
+-- | Type familiy for evolving optional params.
+type MaybePhaseF :: ChartPhase -> Type -> Type
+type family MaybePhaseF p a where
+  MaybePhaseF ChartArgs a = Maybe a
+  MaybePhaseF ChartFinal a = a
+
+-- | Params for making charts. The parameter is so we can re-use this type
+-- for when providing paths are optional (CLI) and when they are mandatory
+-- ('createChartsJsonFile', after filling in missing values with defaults).
+type ChartParams :: ChartPhase -> Type
+data ChartParams p = MkChartParams
+  { -- | Path to input chart-requests.toml file.
+    chartRequestsPath :: MaybePhaseF p OsPath,
+    -- | Path to output charts.json file.
+    outJsonPath :: MaybePhaseF p OsPath,
+    -- | Path to input runs.toml file.
+    runsPath :: MaybePhaseF p OsPath
+  }
+
+deriving stock instance (Eq (MaybePhaseF p OsPath)) => Eq (ChartParams p)
+
+deriving stock instance (Show (MaybePhaseF p OsPath)) => Show (ChartParams p)
+
+type ChartParamsArgs = ChartParams ChartArgs
+
+type ChartParamsFinal = ChartParams ChartFinal
+
+instance Semigroup ChartParamsArgs where
+  MkChartParams x1 x2 x3 <> MkChartParams y1 y2 y3 =
+    MkChartParams (x1 <|> y1) (x2 <|> y2) (x3 <|> y3)
+
+instance Monoid ChartParamsArgs where
+  mempty = MkChartParams mempty mempty mempty
+
+-- | Given 'ChartParamsFinal', generates a json-encoded array of charts, and
+-- writes the file to the given location.
+createChartsJsonFile :: ChartParamsFinal -> IO ()
+createChartsJsonFile params = do
+  bs <- createChartsJsonBS (Just params.runsPath) (Just params.chartRequestsPath)
+
+  let outFile = params.outJsonPath
+      (dir, _) = OsPath.splitFileName outFile
+
+  Dir.createDirectoryIfMissing True dir
+
+  writeBinaryFileIO params.outJsonPath (toStrictByteString bs)
+
+-- | Given file paths to runs and chart requests, returns a lazy
+-- json-encoded bytestring of a chart array.
+createChartsJsonBS ::
+  -- | Path to runs.toml. Defaults to 'defRunsPath'.
+  Maybe OsPath ->
+  -- | Path to chart-requests.toml. Defaults to 'defChartRequestsPath'.
+  Maybe OsPath ->
+  IO LazyByteString
+createChartsJsonBS mRunsTomlPath mChartRequestsPath =
+  AsnPretty.encodePretty' cfg <$> createChartSeq runsTomlPath chartRequestsPath
+  where
+    chartRequestsPath = fromMaybe defChartRequestsPath mChartRequestsPath
+    runsTomlPath = fromMaybe defRunsPath mRunsTomlPath
+
+    cfg =
+      AsnPretty.defConfig
+        { confIndent = Spaces 2,
+          confTrailingNewline = True
+        }
+
+-- | Given file paths to runs and chart requests, generates a sequence of
+-- charts.
+createChartSeq ::
+  -- | Path to runs.toml
+  OsPath ->
+  -- | Path to chart-requests.toml
+  OsPath ->
+  IO (Seq Chart)
+createChartSeq runsPath chartRequestsPath = do
+  runs <- readDecodeToml @(SomeRuns Double) runsPath
+  chartRequests <- readDecodeToml @ChartRequests chartRequestsPath
+
+  pure $ Chart.mkCharts runs chartRequests
+  where
+    readDecodeToml :: forall a. (DecodeTOML a) => OsPath -> IO a
+    readDecodeToml = failMapLeft displayException . decode <=< readFileUtf8
+
+-- | Advances the ChartParams phase, filling in missing values with defaults.
+advancePhase :: ChartParamsArgs -> ChartParamsFinal
+advancePhase paramsArgs =
+  MkChartParams
+    { chartRequestsPath = fromMaybe defChartRequestsPath paramsArgs.chartRequestsPath,
+      outJsonPath = fromMaybe defOutJsonPath paramsArgs.outJsonPath,
+      runsPath = fromMaybe defRunsPath paramsArgs.runsPath
+    }
+
+defChartRequestsPath :: OsPath
+defChartRequestsPath = [ospPathSep|backend/data/input/chart-requests.toml|]
+
+defOutJsonPath :: OsPath
+defOutJsonPath = [ospPathSep|web/data/input/charts.json|]
+
+defRunsPath :: OsPath
+defRunsPath = [ospPathSep|backend/data/input/runs.toml|]

backend/src/Pacer/Chart/Data/Chart.hs

@@ -12,6 +12,7 @@ import Data.List qualified as L
 import Data.Sequence qualified as Seq
 import Pacer.Chart.Data.ChartRequest
   ( ChartRequest (title, yAxis, yAxis1),
+    ChartRequests (unChartRequests),
     YAxisType
       ( YAxisDistance,
         YAxisDuration,
@@ -55,7 +56,7 @@ instance ToJSON Chart where
   toJSON c =
     Asn.object
       [ "title" .= c.title,
-        "values" .= c.chartData
+        "data" .= c.chartData
       ]
 
 -- | Data for a chart with a single Y axis.
@@ -124,9 +125,9 @@ mkCharts ::
     ToReal a
   ) =>
   SomeRuns a ->
-  List ChartRequest ->
-  List Chart
-mkCharts runs = fmap (mkChart runs)
+  ChartRequests ->
+  Seq Chart
+mkCharts runs = fmap (mkChart runs) . (.unChartRequests)
 
 -- NOTE: HLint incorrectly thinks some brackets are unnecessary.
 -- See NOTE: [Brackets with OverloadedRecordDot].
@@ -190,7 +191,7 @@ mkChart (MkSomeRuns someRuns@((MkSomeRun @distUnit sd _) :<|| _)) request =
     toY = toYHelper request.yAxis
 
     toYHelper :: YAxisType -> SomeRun a -> Double
-    toYHelper axisType (MkSomeRun @distUnit2 s r) = case axisType of
+    toYHelper axisType (MkSomeRun s r) = case axisType of
       YAxisDistance ->
         withSingI s $ toℝ $ case finalDistUnit of
           -- NOTE: [Brackets with OverloadedRecordDot]

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

@@ -133,7 +133,7 @@ instance DecodeTOML ChartRequest where
         }
 
 -- | List of chart requests.
-newtype ChartRequests = MkChartRequests (List ChartRequest)
+newtype ChartRequests = MkChartRequests {unChartRequests :: Seq ChartRequest}
   deriving stock (Eq, Show)
 
 instance DecodeTOML ChartRequests where

backend/src/Pacer/Chart/Data/Run.hs

@@ -145,7 +145,6 @@ instance
       == toMeters y
 
 instance (Show a) => Show (SomeRun a) where
-  -- show (MkSomeRun s r) = todo
   showsPrec i (MkSomeRun s r) =
     showParen
       (i >= 11)