From 58e3152f6e31a9dfa94cafeee8c4543f322a45b7 Mon Sep 17 00:00:00 2001 From: Tommy Bidne Date: Mon, 16 Dec 2024 14:33:34 +1300 Subject: [PATCH] Initial chart generation and tests --- .github/workflows/ci.yaml | 56 +++---- .gitignore | 1 + .../data/input/example/chart-requests.toml | 0 .../data/input/example/runs.toml | 0 backend/pacer.cabal | 29 ++-- backend/src/Pacer/Chart.hs | 143 ++++++++++++++++++ backend/src/Pacer/Chart/Data/Chart.hs | 11 +- backend/src/Pacer/Chart/Data/ChartRequest.hs | 2 +- backend/src/Pacer/Chart/Data/Run.hs | 1 - backend/src/Pacer/Config/Args/Command.hs | 92 ++++++++++- backend/src/Pacer/Driver.hs | 26 +++- backend/src/Pacer/Prelude.hs | 26 +++- backend/test/functional/Functional/Chart.hs | 33 ++++ backend/test/functional/Functional/Prelude.hs | 67 ++++++++ backend/test/functional/Main.hs | 8 +- .../data/testSimple_chart-requests.toml | 19 +++ .../test/functional/data/testSimple_runs.toml | 17 +++ .../goldens/testExampleChart.golden | 64 ++++++++ .../test/functional/goldens/testSimple.golden | 64 ++++++++ .../Unit/Pacer/Chart/Data/ChartRequest.hs | 3 +- .../test/unit/Unit/Pacer/Chart/Data/Run.hs | 2 +- web/src/build_charts.ts | 2 +- web/src/charts.json | 60 -------- 23 files changed, 595 insertions(+), 131 deletions(-) rename data/example_chart_requests.toml => backend/data/input/example/chart-requests.toml (100%) rename data/example_runs.toml => backend/data/input/example/runs.toml (100%) create mode 100644 backend/src/Pacer/Chart.hs create mode 100644 backend/test/functional/Functional/Chart.hs create mode 100644 backend/test/functional/data/testSimple_chart-requests.toml create mode 100644 backend/test/functional/data/testSimple_runs.toml create mode 100644 backend/test/functional/goldens/testExampleChart.golden create mode 100644 backend/test/functional/goldens/testSimple.golden delete mode 100644 web/src/charts.json diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 3385656..0d54288 100644 --- a/.github/workflows/ci.yaml +++ b/.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 diff --git a/.gitignore b/.gitignore index 452c8ac..affc5d2 100644 --- a/.gitignore +++ b/.gitignore @@ -9,5 +9,6 @@ cabal.project.local /result # web +/web/data/input/charts.json /web/dist /web/node_modules diff --git a/data/example_chart_requests.toml b/backend/data/input/example/chart-requests.toml similarity index 100% rename from data/example_chart_requests.toml rename to backend/data/input/example/chart-requests.toml diff --git a/data/example_runs.toml b/backend/data/input/example/runs.toml similarity index 100% rename from data/example_runs.toml rename to backend/data/input/example/runs.toml diff --git a/backend/pacer.cabal b/backend/pacer.cabal index b712a2a..719cbcf 100644 --- a/backend/pacer.cabal +++ b/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 diff --git a/backend/src/Pacer/Chart.hs b/backend/src/Pacer/Chart.hs new file mode 100644 index 0000000..17cbd4d --- /dev/null +++ b/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|] diff --git a/backend/src/Pacer/Chart/Data/Chart.hs b/backend/src/Pacer/Chart/Data/Chart.hs index d8e5405..5869ec3 100644 --- a/backend/src/Pacer/Chart/Data/Chart.hs +++ b/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] diff --git a/backend/src/Pacer/Chart/Data/ChartRequest.hs b/backend/src/Pacer/Chart/Data/ChartRequest.hs index 212151a..b752b2c 100644 --- a/backend/src/Pacer/Chart/Data/ChartRequest.hs +++ b/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 diff --git a/backend/src/Pacer/Chart/Data/Run.hs b/backend/src/Pacer/Chart/Data/Run.hs index ddd08ca..ada7104 100644 --- a/backend/src/Pacer/Chart/Data/Run.hs +++ b/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) diff --git a/backend/src/Pacer/Config/Args/Command.hs b/backend/src/Pacer/Config/Args/Command.hs index ac376fd..2a89d6e 100644 --- a/backend/src/Pacer/Config/Args/Command.hs +++ b/backend/src/Pacer/Config/Args/Command.hs @@ -17,11 +17,12 @@ module Pacer.Config.Args.Command ) where -import Options.Applicative - ( Parser, - ) +import FileSystem.OsPath qualified as OsPath +import Options.Applicative (Parser) import Options.Applicative qualified as OA import Options.Applicative.Types (ReadM) +import Pacer.Chart (ChartParams (MkChartParams), ChartParamsArgs) +import Pacer.Chart qualified as Chart import Pacer.Class.Parser qualified as P import Pacer.Config.Args.Utils qualified as Utils import Pacer.Data.Distance (SomeDistance) @@ -31,7 +32,9 @@ import Pacer.Prelude -- | Possible commands data Command - = -- | Given 2 of distance, duration, and pace, derives the 3rd. + = -- | Generate charts + Chart ChartParamsArgs + | -- | Given 2 of distance, duration, and pace, derives the 3rd. Derive DistanceDurationPaceArgs | -- | Scales a value. Scale DistanceDurationPaceArgs PDouble @@ -120,11 +123,13 @@ cmdParser :: Parser Command cmdParser = OA.hsubparser ( mconcat - [ Utils.mkCommand "derive" deriveParser deriveTxt, + [ Utils.mkCommand "chart" chartParser chartTxt, + Utils.mkCommand "derive" deriveParser deriveTxt, Utils.mkCommand "scale" scaleParser scaleTxt ] ) where + chartTxt = Utils.mkCommandDesc "Generates charts json file" deriveTxt = Utils.mkCommandDesc $ mconcat @@ -136,6 +141,7 @@ cmdParser = Utils.mkCommandDesc "Scales a quantity. Requires exactly one quantity and the scale factor." + chartParser = Chart <$> chartParamsArgsParser deriveParser = Derive <$> convertDistanceDurationPaceArgsParser scaleParser = Scale @@ -215,6 +221,82 @@ convertPaceOptUnitsParser = paceOptUnitsParser helpTxt "allowed." ] +chartParamsArgsParser :: Parser ChartParamsArgs +chartParamsArgsParser = do + chartRequestsPath <- chartRequestsPathParser + runsPath <- runsPathParser + outJsonPath <- outJsonPathParser + + pure + $ MkChartParams + { chartRequestsPath, + runsPath, + outJsonPath + } + +chartRequestsPathParser :: Parser (Maybe OsPath) +chartRequestsPathParser = + OA.optional + $ OA.option + read + ( mconcat + [ OA.short 'c', + OA.long "chart-requests", + OA.metavar "PATH", + Utils.mkHelp + $ mconcat + [ "Path to chart-requests toml file. If not given, defaults to '", + OsPath.decodeLenient Chart.defChartRequestsPath, + "'" + ] + ] + ) + where + read :: ReadM OsPath + read = OA.str >>= OsPath.encodeFail + +runsPathParser :: Parser (Maybe OsPath) +runsPathParser = + OA.optional + $ OA.option + read + ( mconcat + [ OA.short 'r', + OA.long "runs", + OA.metavar "PATH", + Utils.mkHelp + $ mconcat + [ "Path to runs toml file. If not given, defaults to '", + OsPath.decodeLenient Chart.defRunsPath, + "'" + ] + ] + ) + where + read :: ReadM OsPath + read = OA.str >>= OsPath.encodeFail + +outJsonPathParser :: Parser (Maybe OsPath) +outJsonPathParser = + OA.optional + $ OA.option + read + ( mconcat + [ OA.short 'j', + OA.long "json", + OA.metavar "PATH", + Utils.mkHelp + $ mconcat + [ "Path to generated json file. If not given, defaults to '", + OsPath.decodeLenient Chart.defOutJsonPath, + "'" + ] + ] + ) + where + read :: ReadM OsPath + read = OA.str >>= OsPath.encodeFail + scalePaceOptUnitsParser :: Parser PaceOptUnits scalePaceOptUnitsParser = paceOptUnitsParser helpTxt where diff --git a/backend/src/Pacer/Driver.hs b/backend/src/Pacer/Driver.hs index a3c2a94..8c47b67 100644 --- a/backend/src/Pacer/Driver.hs +++ b/backend/src/Pacer/Driver.hs @@ -5,10 +5,13 @@ module Pacer.Driver ) where +import FileSystem.OsPath qualified as OsPath import Options.Applicative qualified as OA +import Pacer.Chart (ChartParamsArgs) +import Pacer.Chart qualified as Chart import Pacer.Config.Args (Args (command), parserInfo) import Pacer.Config.Args.Command - ( Command (Derive, Scale), + ( Command (Chart, Derive, Scale), DeriveFinal (DeriveDistance, DeriveDuration, DerivePace), DistanceDurationPaceArgs, ScaleFinal (ScaleDistance, ScaleDuration, ScalePace), @@ -32,9 +35,30 @@ runAppWith :: (Text -> IO a) -> IO a runAppWith handler = do args <- OA.execParser parserInfo case args.command of + Chart chartArgs -> handleChart handler chartArgs Derive ddpArgs -> handleDerive handler ddpArgs Scale ddpArgs scaleFactor -> handleScale handler ddpArgs scaleFactor +handleChart :: (Text -> IO a) -> ChartParamsArgs -> IO a +handleChart handler chartParamsArgs = do + Chart.createChartsJsonFile chartParamsFinal + + handler msg + where + chartParamsFinal = Chart.advancePhase chartParamsArgs + + msg = + mconcat + [ "Successfully created charts.\n", + " - runs: '", + packText $ OsPath.decodeLenient chartParamsFinal.runsPath, + "'\n - chart-requests: '", + packText $ OsPath.decodeLenient chartParamsFinal.chartRequestsPath, + "'\n - output: '", + packText $ OsPath.decodeLenient chartParamsFinal.outJsonPath, + "'" + ] + handleDerive :: (Text -> IO a) -> DistanceDurationPaceArgs -> IO a handleDerive handler ddpArgs = argsToDerive ddpArgs >>= \case diff --git a/backend/src/Pacer/Prelude.hs b/backend/src/Pacer/Prelude.hs index 6346d8a..7f5ca75 100644 --- a/backend/src/Pacer/Prelude.hs +++ b/backend/src/Pacer/Prelude.hs @@ -25,6 +25,10 @@ module Pacer.Prelude TextBuilder, builderToLazyText, + -- * File IO + readFileUtf8, + writeFileUtf8, + -- * Singletons fromSingI, @@ -59,6 +63,8 @@ module Pacer.Prelude -- * Misc errorLeft, errorMapLeft, + failLeft, + failMapLeft, readFail, -- Prelude re-exports @@ -167,11 +173,12 @@ import Data.Tuple as X (fst, snd) #if MIN_VERSION_base(4, 20, 0) import Data.Tuple.Experimental as X (Tuple2, Tuple3, Tuple4) #endif +import Data.Text.Encoding (encodeUtf8) import Data.Type.Equality as X (type (~)) import Data.Void as X (Void, absurd) import Data.Word as X (Word32) -import FileSystem.IO as X (readBinaryFileIO) -import FileSystem.OsPath as X (OsPath, ospPathSep) +import FileSystem.IO as X (readBinaryFileIO, writeBinaryFileIO) +import FileSystem.OsPath as X (OsPath, osp, ospPathSep, ()) import FileSystem.UTF8 as X (decodeUtf8ThrowM) import GHC.Enum as X (Bounded (maxBound, minBound), Enum) import GHC.Err as X (error, undefined) @@ -254,13 +261,20 @@ import System.IO as X (IO, putStrLn) import Text.Read as X (readMaybe) import Text.Read qualified as TR -errorMapLeft :: (HasCallStack) => (a -> String) -> Either a c -> c +errorMapLeft :: (HasCallStack) => (a -> String) -> Either a b -> b errorMapLeft f = errorLeft . first f errorLeft :: (HasCallStack) => Either String a -> a errorLeft (Left str) = error str errorLeft (Right x) = x +failMapLeft :: (MonadFail m) => (a -> String) -> Either a b -> m b +failMapLeft f = failLeft . first f + +failLeft :: (MonadFail m) => Either String a -> m a +failLeft (Left str) = fail str +failLeft (Right x) = pure x + showt :: (Show a) => a -> Text showt = packText . show @@ -346,3 +360,9 @@ readFail tyStr s = case TR.readMaybe s of listToNESeq :: (HasCallStack) => List a -> NESeq a listToNESeq = NESeq.fromList . NE.fromList + +readFileUtf8 :: OsPath -> IO Text +readFileUtf8 = decodeUtf8ThrowM <=< readBinaryFileIO + +writeFileUtf8 :: OsPath -> Text -> IO () +writeFileUtf8 p = writeBinaryFileIO p . encodeUtf8 diff --git a/backend/test/functional/Functional/Chart.hs b/backend/test/functional/Functional/Chart.hs new file mode 100644 index 0000000..1622879 --- /dev/null +++ b/backend/test/functional/Functional/Chart.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Functional.Chart (tests) where + +import Functional.Prelude +import Pacer.Chart qualified as Chart + +tests :: TestTree +tests = + testGroup + "Pacer.Chart" + [ testExampleChart, + testSimple + ] + +testExampleChart :: TestTree +testExampleChart = testGoldenParams params + where + params = + MkGoldenParams + { testDesc = "Generates example", + testName = [osp|testExampleChart|], + runner = + toStrictByteString + <$> Chart.createChartsJsonBS + (Just runsPath) + (Just chartRequestsPath) + } + runsPath = [osp|data/input/example/runs.toml|] + chartRequestsPath = [osp|data/input/example/chart-requests.toml|] + +testSimple :: TestTree +testSimple = testChart "Simple example" [osp|testSimple|] diff --git a/backend/test/functional/Functional/Prelude.hs b/backend/test/functional/Functional/Prelude.hs index 5fc3460..4b6666f 100644 --- a/backend/test/functional/Functional/Prelude.hs +++ b/backend/test/functional/Functional/Prelude.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE QuasiQuotes #-} module Functional.Prelude ( module X, @@ -10,10 +11,16 @@ module Functional.Prelude runMultiArgs, runArgs, runException, + + -- * Golden + GoldenParams (..), + testGoldenParams, + testChart, ) where import Data.Word (Word8) +import FileSystem.OsPath qualified as FS.OsPath import Hedgehog as X ( Gen, Property, @@ -30,11 +37,13 @@ import Hedgehog as X (/==), (===), ) +import Pacer.Chart qualified as Chart import Pacer.Driver (runAppWith) import Pacer.Prelude as X hiding (IO) import System.Environment (withArgs) import System.IO as X (IO) import Test.Tasty as X (TestName, TestTree, testGroup) +import Test.Tasty.Golden as X (goldenVsFile) import Test.Tasty.HUnit as X ( Assertion, assertBool, @@ -86,3 +95,61 @@ runException desc expected args = testCase desc $ do case eResult of Right r -> assertFailure $ unpackText $ "Expected exception, received: " <> r Left ex -> expected @=? displayExceptiont ex + +data GoldenParams = MkGoldenParams + { testDesc :: TestName, + testName :: OsPath, + runner :: IO ByteString + } + +-- | Given a text description and testName OsPath, creates a golden test. +-- Expects the following to exist: +-- +-- - @data\/testName_runs.toml@ +-- - @data\/testName_chart-requests.toml@ +-- - @goldens\/testName.golden@ +-- +-- Note that, confusingly, the 'TestName' type is __not__ what we are +-- referring to as testName. Rather, tasty takes in a string test +-- __description__, which has type 'TestName'. We call this description +-- +-- By 'test name', we refer to the actual function name e.g. in +-- +-- @ +-- testFoo = testChart "some description" [osp|testFoo|] +-- @ +-- +-- testFoo is the 'test name'. +testChart :: TestName -> OsPath -> TestTree +testChart desc testName = testGoldenParams params + where + params = + MkGoldenParams + { testDesc = desc, + testName, + runner = + toStrictByteString + <$> Chart.createChartsJsonBS + (Just runsPath) + (Just chartRequestsPath) + } + basePath = [ospPathSep|test/functional/data|] + chartRequestsPath = basePath testName <> [osp|_chart-requests.toml|] + runsPath = basePath testName <> [osp|_runs.toml|] + +testGoldenParams :: GoldenParams -> TestTree +testGoldenParams goldenParams = + goldenVsFile goldenParams.testDesc goldenPath actualPath $ do + bs <- goldenParams.runner + writeActualFile bs + where + outputPathStart = + FS.OsPath.unsafeDecode + $ [ospPathSep|test/functional/goldens|] + goldenParams.testName + + writeActualFile :: ByteString -> IO () + writeActualFile = writeBinaryFileIO (FS.OsPath.unsafeEncode actualPath) + + actualPath = outputPathStart <> ".actual" + goldenPath = outputPathStart <> ".golden" diff --git a/backend/test/functional/Main.hs b/backend/test/functional/Main.hs index d35d671..733c84f 100644 --- a/backend/test/functional/Main.hs +++ b/backend/test/functional/Main.hs @@ -2,16 +2,20 @@ module Main (main) where +import Functional.Chart qualified import Functional.Derive qualified import Functional.Prelude import Functional.Scale qualified -import Test.Tasty (defaultMain) +import Test.Tasty (defaultMain, localOption) +import Test.Tasty.Golden (DeleteOutputFile (OnPass)) main :: IO () main = defaultMain + $ localOption OnPass $ testGroup "Functional" - [ Functional.Derive.tests, + [ Functional.Chart.tests, + Functional.Derive.tests, Functional.Scale.tests ] diff --git a/backend/test/functional/data/testSimple_chart-requests.toml b/backend/test/functional/data/testSimple_chart-requests.toml new file mode 100644 index 0000000..91ad65b --- /dev/null +++ b/backend/test/functional/data/testSimple_chart-requests.toml @@ -0,0 +1,19 @@ +[[charts]] +title = 'Runs by distance' +y-axis = 'distance' + +# Only takes runs with label 'label1' +[[charts]] +filters = ['label1'] +title = 'Runs by duration' +y-axis = 'duration' +y-axis1 = 'distance' + +# Only takes runs with all of the following conditions: +# +# 1. Has label 'label1' +# 2. Has label 'label2' OR does not have label 'label3' +[[charts]] +filters = ['label1', 'or (label2) (not (label3))'] +title = 'Runs by pace' +y-axis = 'pace' diff --git a/backend/test/functional/data/testSimple_runs.toml b/backend/test/functional/data/testSimple_runs.toml new file mode 100644 index 0000000..3614e92 --- /dev/null +++ b/backend/test/functional/data/testSimple_runs.toml @@ -0,0 +1,17 @@ +[[runs]] +datetime = 2024-10-20 +distance = '5 km' +duration = '20m30s' + +[[runs]] +datetime = 2024-10-20T14:30:00 +distance = '20 miles' +duration = '2h40m54s' +labels = [] + +[[runs]] +datetime = 2024-10-25T12:00:00-08:00 +distance = 'marathon' +duration = '3h20m' +labels = ['official', 'marathon'] +title= 'Some Marathon' diff --git a/backend/test/functional/goldens/testExampleChart.golden b/backend/test/functional/goldens/testExampleChart.golden new file mode 100644 index 0000000..4b5ad8f --- /dev/null +++ b/backend/test/functional/goldens/testExampleChart.golden @@ -0,0 +1,64 @@ +[ + { + "data": { + "x": [ + "2024-10-20", + "2024-10-20T14:30:00", + "2024-10-25T12:00:00-08:00" + ], + "y": { + "label": "km", + "values": [ + 5, + 32.18, + 42.195 + ] + } + }, + "title": "Runs by distance" + }, + { + "data": { + "x": [ + "2024-10-20", + "2024-10-20T14:30:00", + "2024-10-25T12:00:00-08:00" + ], + "y": { + "label": "time", + "values": [ + 1230, + 9654, + 12000 + ] + }, + "y1": { + "label": "km", + "values": [ + 5, + 32.18, + 42.195 + ] + } + }, + "title": "Runs by duration" + }, + { + "data": { + "x": [ + "2024-10-20", + "2024-10-20T14:30:00", + "2024-10-25T12:00:00-08:00" + ], + "y": { + "label": "/km", + "values": [ + 246, + 300, + 284.3938855314611 + ] + } + }, + "title": "Runs by pace" + } +] diff --git a/backend/test/functional/goldens/testSimple.golden b/backend/test/functional/goldens/testSimple.golden new file mode 100644 index 0000000..4b5ad8f --- /dev/null +++ b/backend/test/functional/goldens/testSimple.golden @@ -0,0 +1,64 @@ +[ + { + "data": { + "x": [ + "2024-10-20", + "2024-10-20T14:30:00", + "2024-10-25T12:00:00-08:00" + ], + "y": { + "label": "km", + "values": [ + 5, + 32.18, + 42.195 + ] + } + }, + "title": "Runs by distance" + }, + { + "data": { + "x": [ + "2024-10-20", + "2024-10-20T14:30:00", + "2024-10-25T12:00:00-08:00" + ], + "y": { + "label": "time", + "values": [ + 1230, + 9654, + 12000 + ] + }, + "y1": { + "label": "km", + "values": [ + 5, + 32.18, + 42.195 + ] + } + }, + "title": "Runs by duration" + }, + { + "data": { + "x": [ + "2024-10-20", + "2024-10-20T14:30:00", + "2024-10-25T12:00:00-08:00" + ], + "y": { + "label": "/km", + "values": [ + 246, + 300, + 284.3938855314611 + ] + } + }, + "title": "Runs by pace" + } +] diff --git a/backend/test/unit/Unit/Pacer/Chart/Data/ChartRequest.hs b/backend/test/unit/Unit/Pacer/Chart/Data/ChartRequest.hs index 78154f9..33edff0 100644 --- a/backend/test/unit/Unit/Pacer/Chart/Data/ChartRequest.hs +++ b/backend/test/unit/Unit/Pacer/Chart/Data/ChartRequest.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE QuasiQuotes #-} module Unit.Pacer.Chart.Data.ChartRequest (tests) where @@ -23,7 +24,7 @@ testParseExampleToml = testProp1 "testParseExampleToml" desc $ do failure where desc = "Parses example toml" - path = [ospPathSep|../data/example_chart_requests.toml|] + path = [ospPathSep|data/input/example/chart-requests.toml|] expected = MkChartRequests diff --git a/backend/test/unit/Unit/Pacer/Chart/Data/Run.hs b/backend/test/unit/Unit/Pacer/Chart/Data/Run.hs index 190444c..9a4449a 100644 --- a/backend/test/unit/Unit/Pacer/Chart/Data/Run.hs +++ b/backend/test/unit/Unit/Pacer/Chart/Data/Run.hs @@ -39,7 +39,7 @@ testParseExampleToml = testProp1 "testParseExampleToml" desc $ do failure where desc = "Parses example toml" - path = [ospPathSep|../data/example_runs.toml|] + path = [ospPathSep|data/input/example/runs.toml|] expected = MkSomeRuns diff --git a/web/src/build_charts.ts b/web/src/build_charts.ts index 1cc839d..c5e5753 100644 --- a/web/src/build_charts.ts +++ b/web/src/build_charts.ts @@ -1,5 +1,5 @@ import { Chart, ChartOptions } from "chart.js/auto"; -import * as charts from "./charts.json"; +import * as charts from "../data/input/charts.json"; import { appendCanvasId, mkChartOptions, mkChartOptions2Y } from "./utils"; function mkDataSet(x: { values: number[]; label: string }) { diff --git a/web/src/charts.json b/web/src/charts.json deleted file mode 100644 index aab9a14..0000000 --- a/web/src/charts.json +++ /dev/null @@ -1,60 +0,0 @@ -[ - { - "title": "Graph 1", - "data": { - "x": [ - "2024-10-05 12:00:00", - "2024-10-05 14:00:00", - "2024-10-10 12:00:00" - ], - "y": { - "values": [ - 5, - 10, - 15 - ], - "label": "a label" - }, - "y1": { - "values": [ - 9, - 3, - 1 - ], - "label": "another label" - } - } - }, - { - "title": "Graph 2", - "data": { - "x": [ - "2024-10-05 12:00:00", - "2024-10-05 14:00:00", - "2024-10-10 12:00:00", - "2024-10-15 12:00:00", - "2024-10-20 12:00:00" - ], - "y": { - "values": [ - 5, - 10, - 15, - 3, - 2 - ], - "label": "blah blah" - }, - "y1": { - "values": [ - 9, - 3, - 1, - 1, - 2 - ], - "label": "moar" - } - } - } -]