Liikuntakirja

Last update: 2024-07-01

Developer's prologue
The Liikuntakirja story
Boilerplate epilogue

This is the literate document of an exercise tracker I made during writing my MSc thesis. I'm not too happy about how Noweb-style programming breaks IDE features, and I want move to a better approach. I'm planning to adapt this to a transcluded implementation, and to change the HTML rendering to support a Htmx frontend. The frontend was left very barebones in this implementation.

Nodes have named Listings. The Listing name is a file path if the node is a root node, and an abstract name if it is being linked to from another node. I tried to find out a well-working HTML export engine that would link nodes using hyperlinks, but no suitable implementations seem to exist.

Developer's prologue

The prologue covers setting up this notebook and the Liikuntakirja exercise tracker program contained within. This notebook and its program has some special requirements that need to be accounted for.

Setup notebook environment

The following can be executed for a temporary session environment for this notebook. Note that while setq is used for temporary effect (instead of customize-variable), use-package will install the packages for good. Code blocks like the one below are run with C-c C-c. For better readability, font and other stylistic configuration in style of Zzamboni's Beautifying Org Mode in Emacs is recommended. This document has some, but is limited to basics for clarity. Tab collapses long code blocks.

An example Emacs configuration

;; Don't confirm killing processes on exit
(setq confirm-kill-processes nil)

;; Set UTF-8 as default encoding
(set-language-environment "UTF-8")
(prefer-coding-system       'utf-8)
(set-default-coding-systems 'utf-8)
(set-terminal-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8)
(setq default-buffer-file-coding-system 'utf-8)

;; No hard tabs, set indentations for major langs
(setq indent-tabs-mode nil)
(setq tab-width 4)
(setq js-indent-level 2)
(setq css-indent-level 2)

;; Initialize package system. Add MELPA.
(setq package-archives
      '(("melpa"     . "https://melpa.org/packages/")
        ("elpa"      . "https://elpa.gnu.org/packages/")))
(package-initialize)
(when (not package-archive-contents)
  (package-refresh-contents))

;; Install use-package, disable verbose loading.
(when (not (package-installed-p 'use-package))
  (package-install 'use-package))
(require 'use-package)
(setq use-package-verbose nil)

;; Org-mode
(use-package org
  :load-path ("lisp/org-mode/lisp" "lisp/org-mode/lisp/contrib/lisp")
  :hook
  (org-babel-after-execute . org-redisplay-inline-images)
  :config
  )

;; nix-mode for syntax highlighting nix configuration files
(use-package nix-mode
  :ensure t)
;; Haskell language & direnv support
(use-package haskell-mode
  :ensure t)
(use-package envrc
  :config
  (envrc-global-mode +1))

;; C-c C-o to open tangled file from a code block with :tangle set.
;; (note: Noweb nodes without :tangle set cannot be opened this way)
(defun ibizaman/org-babel-goto-tangle-file ()
  (if-let* ((args (nth 2 (org-babel-get-src-block-info t)))
            (tangle (alist-get :tangle args)))
      (when (not (equal "no" tangle))
        (find-file tangle)
        t)))
(add-hook 'org-open-at-point-functions 'ibizaman/org-babel-goto-tangle-file)

;; eglot haskell IDE can be used within tangled files
;; (note: changes cannot be 'detangled' back to the notebook)
(use-package eglot
  :config
  (add-hook 'haskell-mode-hook #'eglot-ensure)
  ;; Optionally add keybindings to some common functions:
  :bind ((:map eglot-mode-map
               ("C-c C-e r" . eglot-rename)
               ("C-c C-e l" . flymake-show-buffer-diagnostics)
               ("C-c C-e p" . flymake-show-project-diagnostics)
               ("C-c C-e C" . eglot-show-workspace-configuration)
               ("C-c C-e R" . eglot-reconnect)
               ("C-c C-e S" . eglot-shutdown)
               ("C-c C-e A" . eglot-shutdown-all)
               ("C-c C-e a" . eglot-code-actions)
               ("C-c C-e f" . eglot-format))))

;; Allow in-place language execution for Latex, Python, Haskell, and shell languages.
(org-babel-do-load-languages
 'org-babel-load-languages
 '((shell   . t)
   (haskell . t)
   (emacs-lisp   . t)))
(setq haskell-process-type 'ghci)

(use-package org-indent
  :ensure nil
  :diminish)

;; Enable navigating via a table of contents in a side buffer
(use-package org-sidebar
  :ensure t)
(add-hook 'org-mode-hook 'org-sidebar-tree-toggle)

;; Hide emphasis markers
(setq org-hide-emphasis-markers t)

;; Font-lock substitution for list markers
(font-lock-add-keywords 'org-mode
                        '(("^ *\\([-]\\) "
                           (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) "•"))))))

;; org-bullets
(use-package org-bullets
  :ensure t
  :config
  (add-hook 'org-mode-hook (lambda () (org-bullets-mode 1))))

;; Mode-specific bookmarks
;; `M-i` to jump in eg. org-mode to select heading in a list of headings.
(use-package imenu-anywhere
  :bind
  ("M-i" . helm-imenu-anywhere))

;; show inline images
(add-hook 'org-mode-hook 'org-display-inline-images)
;; miscellaneous
(setq sentence-end-double-space nil)

;; enable scrollbar
(scroll-bar-mode 1)
;; enable things hooked onto org-mode in this file
(org-bullets-mode 1)
(org-sidebar-tree-toggle)
(org-display-inline-images)

variable-pitch-mode is highly recommended. Default theme does not differentiate between code blocks and prose, which makes using it moot. To enable differentiation, using a non-default theme like poet is required.

(variable-pitch-mode 1)

(use-package poet-theme
  :ensure t)
(load-theme 'poet t)

Every block that does have results header can be executed. If you don't want to be yes/no prompted every time you execute a block, you can disable the prompt by

(setq org-confirm-babel-evaluate nil)

Saving & tangling this file might induce a ~second long garbage collection operation as it makes ~50MB worth of data structures. Garbage collection threshold should be raised to e.g. 512 megabytes from the default ~800 kilobytes. Exact number depends on how much RAM is disposable while the Emacs process is running.

(setq gc-cons-threshold (* 512 1024 1024)) ;; 512 MB
;; Garbage collect on unfocus to avoid noticeable stutter
(add-function :after
              after-focus-change-function
              (lambda () (unless (frame-focus-state) (garbage-collect))))

To run frontend visualizations, a Chromium binary is required.

Listing 1: Chromium binary

/usr/bin/chromium-browser

Following options are used when calling browser binary. DPI is 96 by default.

Listing 2: Chromium options

--headless --window-size=<<Testing viewport size>> --disable-gpu --screenshot --run-all-compositor-stages-before-draw --virtual-time-budget=200

The user's viewport is assumed as

Listing 3: Testing viewport size

1920x1200

ImageMagick's convert is used to scale down the visualizations for viewability

Listing 4: Post-process screenshot

convert screenshot.png -resize <<Visualization size>>

Availability can be checked with which.

which convert

Visualizations using an image file will be downscaled to following format

Listing 5: Visualization size

640x400

If using Org 9.6 or earlier (M-x org-version), executing blocks that produce graphics will error when using indirect buffers (usually via org-sidebar). This is fixed in yet-to-be-released Org 9.7 (commit c730caf51). As a one-liner fix, it can also be hackily patched by hand in ob-core.el (not .elc) usually found in /usr/share/emacs/[version number]/lisp/org/.

Weaving this notebook

A liikuntakirja.html can be produced in the working directory and opened in your default browser with C-c C-e h o. For syntax highlighting, htmlize can be installed, which automatically hooks on to the HTML export function.

(use-package htmlize
  :ensure t)

However, this notebook might be better read via Emacs' interface, with things like variable-pitch-mode, org-sidebar, and a suitable theme set.

Install IHP prerequisites

Integrated Haskell Platform is a fairly opinionated batteries-included web framework. It follows an MVC design and includes live reloading plus reproducible development and deployment environments (a sandbox). PostgreSQL is used out of the box for the model and is installed inside the application's sandbox. The sandbox is done using Nix. Nix depends on Git, Curl, Make, and Direnv.

These steps have been derived from the IHP guide.

Listing 6: An example shell command for Dnf package manager with Fedora repositories.

sudo dnf install git curl make direnv

Then we can install Nix. Note: The Nix installer appends your terminal emulator configuration to enable Direnv support.

curl -L https://nixos.org/nix/install | sh

After running the install script, shell environment has to be reloaded. To brute force this, restart Emacs and the shell session it's running in. Sourcing your appended terminal emulator configuration can be enough if you know what you are doing.

Setup IHP and the initial project

IHP uses a web application creation script they call ihp-new found in the Nix repositories.

nix-env --install ihp-new

However, IHP uses Nix "flake" architecture, which requires special handling when used inside git repositories like the one this notebook is in (nix issue #6642, ihp issue #1787). To work around this issue, a separate git repository has to be created for the program itself. As of writing this, Nix repositories still had an outdated ihp-new lacking automatic git init, so a newer ihp-new (commit 016a14d) from IHP repository is bundled with this notebook. The newer one will initialize git repository using default credentials and options.

Setting an IHP project up for the first time can take a long time, is verbose, and asks if precompiled binaries can be used. Thus, it may be preferable to run it in a separate terminal without piping yes. If using precompiled binaries is fine and you don't want to see progress bars, it can be run inside the notebook:

yes | ./ihp-new liikuntakirja

With the project set up, this document should now be tangled with C-c C-v t (org-babel-tangle).

The following assets are needed inside the program.

wget https://cdnjs.cloudflare.com/ajax/libs/Chart.js/4.4.1/chart.umd.min.js -P ./liikuntakirja/static/ # frontend plotting library

If you intend to edit the code, setting the editor to save on unfocus and to tangle on save smoothens the experience. Combined with IHP's reactive coding (autoreloading), it tightens up the interactive loop.

;; Tangle on save
(add-hook 'org-mode-hook
          (lambda () (add-hook 'after-save-hook #'org-babel-tangle
                          :append :local)))
;; Save on unfocus
(defun save-all ()
  (interactive)
  (save-some-buffers t))
(add-hook 'focus-out-hook 'save-all)

Project configuration

Org Mode's Babel interfaces lean on regex pattern matching. To get ob-haskell to execute Haskell blocks properly, we have to amend the default .ghci file with the default ghci prompt (ghci>), instead of the one set by IHP (IHP>).

Listing 7: Set default GHCi prompt

:set prompt "ghci> "

Listing 8: .ghci

:set -XNoImplicitPrelude
:def loadFromIHP \file -> (System.Environment.getEnv "IHP_LIB") >>= (\ihpLib -> readFile (ihpLib <> "/" <> file))
:loadFromIHP applicationGhciConfig
import IHP.Prelude
<<Set default GHCi prompt>>

Any external programs or Haskell libraries should be added into the flake.nix which reproducibly builds the software environment for the program for any new deployment.

Listing 9: flake.nix

{
    inputs = {
        ihp.url = "github:digitallyinduced/ihp/v1.2";
        nixpkgs.follows = "ihp/nixpkgs";
        flake-parts.follows = "ihp/flake-parts";
        devenv.follows = "ihp/devenv";
        systems.follows = "ihp/systems";
    };

    outputs = inputs@{ self, nixpkgs, ihp, flake-parts, systems, ... }:
        flake-parts.lib.mkFlake { inherit inputs; } {

            systems = import systems;
            imports = [ ihp.flakeModules.default ];

            perSystem = { pkgs, ... }: {
                ihp = {
                    enable = true;
                    projectPath = ./.;
                    packages = with pkgs; [
                        # Native dependencies, e.g. imagemagick
                    ];
                    haskellPackages = p: with p; [
                        # Haskell dependencies go here
                        p.ihp
                        cabal-install
                        base
                        wai
                        text
                        <<Haskell dependencies>>
                    ];
                };

                # Custom configuration that will start with `devenv up`
                devenv.shells.default = {
                    # Start Mailhog on local development to catch outgoing emails
                    # services.mailhog.enable = true;

                    # Custom processes that don't appear in https://devenv.sh/reference/options/
                    processes = {
                        # Uncomment if you use tailwindcss.
                        # tailwind.exec = "tailwindcss -c tailwind/tailwind.config.js -i ./tailwind/app.css -o static/app.css --watch=always";
                    };
                };
            };
        };
}

Every IHP program has a global config.

Listing 10: Config/Config.hs

module Config where

import IHP.Prelude
import IHP.Environment
import IHP.FrameworkConfig
<<Import upload configuration>>

config :: ConfigBuilder
config = do
  <<Set development or production flags>>
  <<Allow uploads>>

Running the program

We will have to set the Development / Production flags and a proper host name in the global config. These are fine for development:

Listing 11: Set development or production flags

option Development
option (AppHostname "localhost")

For deployment, following settings are then used:

option Production
option (AppHostname "domain.tld")

The development mode has nice things like live reloading.

Listing 12: Development scripts

<script id="livereload-script" src={assetPath "/livereload.js"} data-ws={liveReloadWebsocketUrl}></script>

The program is run either by running devenv up or the start script. The front page should open up in your default browser (via xdg-open) once the web server has started. The user interfacing part runs on port 8000 and the IHP IDE on 8001. The program can be run in a separate session inside this notebook environment (async is broken on some setups):

./start

Everything should now be set for both running the program and the untangled blocks of code in this notebook. The following block can be used to test if the environment is set up properly. In this case we'll show the whole output and not just the evaluated result, so any compilation errors can be easily seen.

:t config

Any code block results can be cleared per-block with C-c C-v k (org-babel-remove-result) and globally using Emacs' universal prefix C-u (C-u C-c C-v k, org-babel-remove-result-one-or-many).

Any tests in this notebook will require a running Liikuntakirja instance, as they use its database interface. If there are type-related compilation issues or database issues (= the schema has been changed after first running start), types & database schema should be reformatted. Either format (migrate) it graphically in the IHP IDE or run:

make db

Unit testing

The project uses HSpec testing framework for unit tests.

Listing 13: Haskell dependencies

hspec

Hspec is a straightforward unit testing suite. We'll set up a root testing file in Test/Main.hs.

Listing 14: Test/Main.hs

module Main where

import Test.Hspec
import IHP.Prelude

<<Unit test modules>>
import Test.Application.TCXSpec

main :: IO ()
main = hspec do
    <<Unit test module functions>>

Listing 15: Import universal IHP unit testing libraries

import Network.HTTP.Types.Status
import Data.Maybe (fromJust)

import IHP.Prelude
import IHP.QueryBuilder (query)
import IHP.Test.Mocking
import IHP.Fetch

import IHP.FrameworkConfig
import IHP.HaskellSupport
import Test.Hspec
import Config
import Generated.Types

Liikuntakirja is mostly actuated via the Activities controller.

Listing 16: Unit test modules

import Test.Controller.ActivitiesSpec

Listing 17: Unit test module functions

Test.Controller.ActivitiesSpec.tests

Listing 18: Test/Controller/ActivitiesSpec.hs

module Test.Controller.ActivitiesSpec where

<<Import universal IHP unit testing libraries>>

import Web.Routes
import Web.Types
import Web.Controller.Activities (insertTcxActivity, queryActivityAndItsChildren, avgOver10s)
import Web.FrontController ()
import Network.Wai
import IHP.ControllerPrelude

import Data.Text (unpack)
import Application.TCX (processTcxFile)
import Test.Controller.HealthInformationsSpec (insertDefaultHealthInformation)

tests :: Spec
tests = aroundAll (withIHPApp WebApplication config) do
        describe "ActivitiesController" $ do
          it "has no existing activities" $ withContext do
            count <- query @Activity
                     |> fetchCount
            count `shouldBe` 0
        <<ActivitiesSpec test function calls>>

<<Test inserting a record provided by Application.TCX into database>>

With the framework set up and the program running in the background (most unit tests require a running PostgreSQL instance), we can now run all the tests by loading Main and running main.

:l Test/Main
main

The Liikuntakirja story

Liikuntakirja is a story of a person wanting to upload, view, and delete their workout sessions originally recorded on a smartwatch. The universal fitness trackers found on market are too complex to use and make compromises to cover all bases. These don't cater to tracking the user's workout sessions in a minimalistic way. The user wants a tracker they can run on their own computer. The user uses cmaion's polar suite (GitHub repository) to interface and produce TCX files.

The user is happy with a unified single-page interface. An exercise session can be selected from a menu and a new one can be uploaded from their computer. At the same time the data from either the newest upload or the one specially selected from the drop-down is shown.

User wants personalized reports about how the metered heart rates matched the physical stress derived from their age. Per-activity, user wants to see their heart rate and possible moving speed, with total distance, and maximum and average heart rate over the activity.

Figure 1: Client's UI mock-up

This document will lead us from the perspective of a user using the software artefact. The user will first see the front page with all added activities indexed. They will then move on to add an activity. Then they will examine the added activity. After that the activity will be deleted as unsatisfactory.

A set of tests will be derived from the story and the code derived from those will be shown as needed, which means any boilerplate without a clear story component can be found in the epilogue. The boilerplate should only have to be edited when refactoring the code.

Since the user is only interested in activities, we can do essentially everything via ActivitiesController. Activity is a data structure signifying a single workout. It is examined closer when the user starts uploading their activities. ActivitiesController produces a View depending on the Action. Multiple Actions can lead to the same View, and in this program's case, since it is a unified single page interface, all Actions eventually lead to IndexView. The IndexView always indexes all the activities. We offer the user abilities to show the newest activity (ActivitiesAction) or a specific activity (ShowActivityAction) with the index. User can also upload (CreateActivityAction) and delete (DeleteActivityAction) activities.

Listing 19: Type ActivitiesController

data ActivitiesController
    = ActivitiesAction
    | ShowActivityAction { activityId :: !(Id Activity) }
    | CreateActivityAction
    | DeleteActivityAction { activityId :: !(Id Activity) }
    deriving (Eq, Show, Data)

All these actions correspond to a function in Controller ActivitiesController type class instance, which acts the main hub of Activity-specific handling.

Listing 20: Web/Controller/Activities.hs

module Web.Controller.Activities where

import Web.Controller.Prelude
import Web.View.Activities.Index

import IHP.ModelSupport (Id')
import Data.Text (pack, unpack)
import qualified Data.Text as T

<<Import TCX conversion functions>>
<<Import Data.Time for sculpting ChartData>>

instance Controller ActivitiesController where
    <<Index Activities using IndexView>>

    <<Show an activity>>

    <<Create Activity from uploaded TCX>>

    <<Delete an activity>>

buildActivity activity = activity
    |> fill @'["sport", "startTime", "planType", "deviceName"]

<<Convert TcxActivity into Activity and other database records>>

<<Query Activity and its children>>

<<Sculpt Activity into ChartData>>

We'll use default routing options and have Web.Controller.Activities imported to Web.FrontController.

Listing 21: Controller routing instances

instance AutoRoute ActivitiesController

Listing 22: Parse controller routes

, parseRoute @ActivitiesController

Listing 23: Import controller actions

import Web.Controller.Activities

User accesses Liikuntakirja via browser

We'll have to set the Action that's triggered on loading /. This goes into the main Web/Routes.hs file.

Listing 24: Set ActivitiesAction as front page

startPage ActivitiesAction

ActivitiesAction will then query all activities from the database and check if there's a newest activity to show.

Listing 25: Index Activities using IndexView

action ActivitiesAction = do
  activities <- query @Activity |> orderByDesc #startTime |> fetch
  healthInfo <- query @HealthInformation |> fetchOne
  (selectedActivity, laps, tps) <- queryActivityAndItsChildren (head activities)
  let newActivity = newRecord
      chartData = chartActivityData healthInfo (selectedActivity, laps, tps)
  render IndexView { .. }

IndexView is going to render the web page for user's browser. It is dependent on a couple of defaults, namely the layout elements universal to any page we will be rendering, defaultLayout.

Listing 26: Web/View/Layout.hs

module Web.View.Layout (defaultLayout, Html) where

import IHP.ViewPrelude
import IHP.Environment
import Generated.Types
import IHP.Controller.RequestContext
import Web.Types
import Web.Routes
import Application.Helper.View

defaultLayout :: Html -> Html
defaultLayout inner = [hsx|
<<Default page layout>>
|]

-- The 'assetPath' function used below appends a `?v=SOME_VERSION` to the static assets in production
-- This is useful to avoid users having old CSS and JS files in their browser cache once a new version is deployed
-- See https://ihp.digitallyinduced.com/Guide/assets.html for more details

stylesheets :: Html
stylesheets = [hsx|
        <<CSS stylesheets>>
    |]

scripts :: Html
scripts = [hsx|
        <<JavaScript libraries>>
    |]

devScripts :: Html
devScripts = [hsx|
        <<Development scripts>>
    |]

metaTags :: Html
metaTags = [hsx|
    <<Meta tags>>
|]

defaultLayout uses a set of JavaScript libraries

Listing 27: JavaScript libraries

{when isDevelopment devScripts}
<script src={assetPath "/vendor/jquery-3.6.0.slim.min.js"}></script>
<script src={assetPath "/vendor/timeago.js"}></script>
<script src={assetPath "/vendor/popper-2.11.6.min.js"}></script>
<script src={assetPath "/vendor/bootstrap-5.2.1/bootstrap.min.js"}></script>
<script src={assetPath "/vendor/flatpickr.js"}></script>
<script src={assetPath "/vendor/morphdom-umd.min.js"}></script>
<script src={assetPath "/vendor/turbolinks.js"}></script>
<script src={assetPath "/vendor/turbolinksInstantClick.js"}></script>
<script src={assetPath "/vendor/turbolinksMorphdom.js"}></script>
<script src={assetPath "/helpers.js"}></script>
<script src={assetPath "/ihp-auto-refresh.js"}></script>
<script src={assetPath "/app.js"}></script>
<<Import JavaScript libraries>>

and a set of CSS stylesheets. Liikuntakirja uses the straightforward if bland Bootstrap stylesheet.

Listing 28: CSS stylesheets

<link rel="stylesheet" href={assetPath "/vendor/bootstrap-5.2.1/bootstrap.min.css"}/>
<link rel="stylesheet" href={assetPath "/vendor/flatpickr.min.css"}/>
<link rel="stylesheet" href={assetPath "/app.css"}/>

Some <meta> tags too, you know, for '90s SEO or something.

Listing 29: Meta tags

<meta charset="utf-8"/>
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<meta property="og:title" content="App"/>
<meta property="og:type" content="website"/>
<meta property="og:url" content="TODO"/>
<meta property="og:description" content="TODO"/>
{autoRefreshMeta}

Finally the default HTML with views like IndexView embedded into inner element.

Listing 30: Default page layout

<!DOCTYPE html>
<html lang="en">
    <head>
        {metaTags}

        {stylesheets}
        {scripts}

        <title>{pageTitleOrDefault "App"}</title>
    </head>
    <body>
        <div class="container mt-4">
            {renderFlashMessages}
            {inner}
        </div>
    </body>
</html>

IndexView then shows the main interface with the found activity and also catalogues all activities. IHP uses JSX-like HSX syntax. HSX enables embedding Haskell bindings inside page layouts. Since HSX contents are not Haskell, they have been abstracted away into separate code blocks.

Listing 31: Web/View/Activities/Index.hs

module Web.View.Activities.Index where
import Web.View.Prelude
import Data.Time.Format (formatTime, defaultTimeLocale)

data IndexView = IndexView { activities :: [Activity]
                           , selectedActivity :: Maybe Activity
                           , chartData :: Maybe ChartData
                           , newActivity :: Activity
                           }

instance View IndexView where
    html IndexView { .. } = [hsx|
        <<Lay out the unified interface>>
    |]

renderSelectedActivity :: Maybe Activity -> Maybe ChartData -> Html
renderSelectedActivity Nothing _ = [hsx|
                                     |]
renderSelectedActivity (Just activity) (Just chartData) = [hsx|
         <<Lay out selected activity>>
                                             |]

renderActivity :: Activity -> Html
renderActivity activity = [hsx|
    <<Lay out the individual Activity for indexing>>
|]

renderHeadline :: Maybe Activity -> Html
renderHeadline Nothing = [hsx|
                                 |]
renderHeadline (Just activity) = [hsx|
    <<Lay out Activity headline>>
|]

renderForm :: Activity -> Html
renderForm activity = formFor activity [hsx|
    <<Lay out Activity upload form>>
|]

navBar :: Html
navBar = [hsx|
    <<Lay out navigation bar>>
    |]
  where
    links = renderBreadcrumb
      [ breadcrumbLink "Settings" EditHealthInformationAction
      ]

The unified interface is laid out using simple HTML and Bootstrap CSS classes.

Listing 32: Lay out the unified interface

{navBar}
{renderHeadline selectedActivity}
<div class="table">
  <table class="table">
    <tr>
      <td>{renderSelectedActivity selectedActivity chartData}</td>
      <td>
        <table class="table">
          <thead>
            <tr>
              <th colspan="2">{renderForm newActivity}</th>
            </tr>
          </thead>
          <tbody>{forEach activities renderActivity}</tbody>
        </table>
      </td>
    </tr>
  </table>
</div>

Listing 33: Lay out the individual Activity for indexing

<tr>
  <td><a href={ShowActivityAction activity.id} style="display:block;text-decoration:none;">{formatTime defaultTimeLocale "%a %b %e" (activity.startTime)}</a></td>
  <td><a href={DeleteActivityAction activity.id} class="js-delete text-muted">Delete</a></td>
</tr>

Listing 34: Lay out Activity headline

<h1>Showing a {activity.planType} from {activity.startTime}</h1>

Listing 35: Lay out navigation bar

{links}

The unified interface can then be seen when loading /Activities

<<Chromium binary>> <<Chromium options>> "http://localhost:8000/Activities"
<<Post-process screenshot>> visualizations/activities_visualization.png

User edits their personal health information

User wants to input age for physical stress analysis. For now, it is left to the user to adjust this when looking at older activities. In a future version, user could put in their birthday and each activity will be adjusted for it in respect to activity time.

Figure 2: UI mockup

Propositions

We'll make a dedicated tests file for handling personal health information. We'll call the base model for this information HealthInformation.

Listing 36: Test/Controller/HealthInformationsSpec.hs

module Test.Controller.HealthInformationsSpec where

<<Import universal IHP unit testing libraries>>

import Web.Routes
import Web.Types
import Web.Controller.HealthInformations ()
import Web.FrontController ()
import Network.Wai
import IHP.ControllerPrelude

import Data.Text (unpack)

tests :: Spec
tests =
  aroundAll (withIHPApp WebApplication config) do
  describe "HealthInformationsController" $ do
    it "should start with one row" $ withContext do
      insertDefaultHealthInformation
      count <- query @HealthInformation |> fetchCount
      count `shouldBe` 1
  <<Call HealthInformation unit tests>>
  describe "HealthInformationsController" $ do
    it "should finish with one row" $ withContext do
      count <- query @HealthInformation |> fetchCount
      count `shouldBe` 1

insertDefaultHealthInformation :: (?modelContext :: ModelContext) => IO HealthInformation
insertDefaultHealthInformation = do
  newRecord @HealthInformation
  |> set #age defaultAge
  |> createRecord

defaultAge = <<Default user age>> :: Int

<<Test HealthInformation model>>

<<Test HealthInformationsController>>

First off, we need to model user's personal health information, namely age. User is not interested in calories burned or other weight/height-related information. There will ever only be one row in the table that is always inserted when setting up database. Program cannot run without the row.

Listing 37: Test HealthInformation model

-- testModel :: Spec
testModel = do
  describe "HealthInformations" $ do
    it "models age" $ withContext do
      health <- query @HealthInformation |> fetchOne
      health.age `shouldSatisfy` (\x -> x >= 0 && x <= 120)

Listing 38: Call HealthInformation unit tests

testModel

The other thing we need is an Edit action which shows an editing view, and an Update action that updates database. We'll also have to agree on a default age for the user.

Listing 39: Test HealthInformationsController

-- testController :: Spec
testController = do
  describe "HealthInformationsController" $ do
    it "calling EditHealthInformationAction renders an editing form" $ withContext do
      mockActionStatus EditHealthInformationAction `shouldReturn` status200
    it "calling UpdateHealthInformationAction updates HealthInformation" $ withContext do
      health <- query @HealthInformation |> fetchOne
      health.age `shouldBe` defaultAge
      callActionWithParams UpdateHealthInformationAction [("age", fromString . unpack . show $ defaultAge + 20)]
      updatedHealth <- query @HealthInformation |> fetchOne
      updatedHealth.age `shouldBe` (defaultAge + 20)

Listing 40: Call HealthInformation unit tests

testController

Listing 41: Default user age

Lastly, we'll add this module to the main unit testing module

Listing 42: Unit test modules

import Test.Controller.HealthInformationsSpec

Listing 43: Unit test module functions

Test.Controller.HealthInformationsSpec.tests

Implementation

Let's set up our model first. We need a very simple table with only one column, and an INSERT statement into the fixtures file. Technically we don't need id, but the IHP architecture expects it (and maybe we'll have e.g. multiple users in the future).

Listing 44: HealthInformation schema

CREATE TABLE health_informations (
    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
    age INT NOT NULL
);

Listing 45: Insert default HealthInformation row

INSERT INTO health_informations (age) VALUES (<<Default user age>>);

With the model set, we'll set up the controller.

Listing 46: Web/Controller/HealthInformations.hs

module Web.Controller.HealthInformations where

import Web.Controller.Prelude
import Web.View.HealthInformations.Edit

instance Controller HealthInformationsController where
  action EditHealthInformationAction = do
        healthInformation <- query @HealthInformation |> fetchOne
        render EditView { .. }

  action UpdateHealthInformationAction = do
        healthInformation <- query @HealthInformation |> fetchOne
        healthInformation
            |> fill @'["age"]
            |> ifValid \case
                Left healthInformation -> render EditView { .. }
                Right healthInformation -> do
                    healthInformation <- healthInformation |> updateRecord
                    setSuccessMessage "Health information updated"
                    redirectTo ActivitiesAction

Listing 47: Type HealthInformationController

data HealthInformationsController
    = EditHealthInformationAction
    | UpdateHealthInformationAction -- { healthInformationId :: !(Id HealthInformation) }
    deriving (Eq, Show, Data)

Listing 48: Controller routing instances

instance AutoRoute HealthInformationsController

Listing 49: Import controller actions

import Web.Controller.HealthInformations

Listing 50: Parse controller routes

, parseRoute @HealthInformationsController

And finally the EditView the controller makes for manipulating the model.

Listing 51: Web/View/HealthInformations/Edit.hs

module Web.View.HealthInformations.Edit where
import Web.View.Prelude

data EditView = EditView { healthInformation :: HealthInformation }

instance View EditView where
    html EditView { .. } = [hsx|
                               <<Lay out health information editing view>>
    |]
        where
            breadcrumb = renderBreadcrumb
                [ breadcrumbLink "Back to activities" ActivitiesAction
                , breadcrumbText "Edit age"
                ]

renderForm :: HealthInformation -> Html
renderForm healthInformation = formFor healthInformation [hsx|
                               <<Lay out health information editing form>>
|]

Listing 52: Lay out health information editing view

{breadcrumb}
<h1>Edit age</h1>
{renderForm healthInformation}

Listing 53: Lay out health information editing form

{textField #age}
{submitButton}

All HSpec tests should now be good:

:l Test/Main
hspec $ Test.Controller.HealthInformationsSpec.tests

The settings interface should look like the mockup in the user story:

<<Chromium binary>> <<Chromium options>> "http://localhost:8000/EditHealthInformation"
<<Post-process screenshot>> visualizations/editsettings_visualization.png

User uploads smartwatch data into Liikuntakirja

The user has TCX-formatted smartwatch data files on their computer, ready for uploading.

Propositions

Since parsing TCX files can be used in other programs too, we make it into a separate module with its own unit test suite.

Listing 54: Test/Application/TCXSpec.hs

module Test.Application.TCXSpec where
import Test.Hspec
import IHP.Prelude
import Data.Time (UTCTime)
import Data.Text.IO (readFile)
import Text.Read (read)

import Application.TCX
import Web.Types

tests :: Spec
tests = do
  <<TCX unit test calls>>

<<TCX to record unit test>>

Listing 55: Unit test module functions

Test.Application.TCXSpec.tests

We will have to parse the XML into a Haskell record form. As XML and Haskell records are structurally similar, while the database model has children pointing to parents instead of parents pointing to children, we're using an intermediate record type. The intermediate record also eases modularization and thus use of the parser in other contexts.

Since the XML files and resulting records are big and not trivially referenced in string form in Haskell, we'll load them from respective files. We're happy with comparing both workout examples against a predefined Show instance results which too have been saved to separate files.

Listing 56: TCX to record unit test

tcxToRecord :: Spec
tcxToRecord = do
  describe "processTcxFile" $ do
    it "can parse and read TCX file into intermediate record" $ do
      convertedWalkingTcx <- processTcxFile "Test/test.walking.tcx"
      resultWalkingTcx <- readFile "Test/test.walking.tcx.result"
      (show convertedWalkingTcx ++ "\n") `shouldBe`
        resultWalkingTcx
      convertedStrengthTcx <- processTcxFile "Test/test.strength.tcx"
      resultStrengthTcx <- readFile "Test/test.strength.tcx.result"
      (show convertedStrengthTcx ++ "\n") `shouldBe`
        resultStrengthTcx

Listing 57: TCX unit test calls

tcxToRecord

In the second step we will map and insert the intermediate record into the database by "inverting" the XML/record rose tree. This happens in ActivitiesController.

Listing 58: Test inserting a record provided by Application.TCX into database

testTcxUpload = do
  describe "ActivitiesController" $ do
    it "adds a TCX upload successfully into database" $ withContext do
      tcx <- fromJust . head <$> processTcxFile "Test/test.strength.tcx"
      insertTcxActivity tcx
      actCount <- query @Activity |> fetchCount
      actCount `shouldBe` 1
      lapCount <- query @Lap |> fetchCount
      actCount `shouldBe` 1
      tpCount <- query @Trackpoint |> fetchCount
      tpCount `shouldBe` 5

Listing 59: ActivitiesSpec test function calls

testTcxUpload

Implementation

To allow user uploads to static/ directory, we'll have to import a configuration and some flags in Config.hs defined at Configure IHP

Listing 60: Import upload configuration

import IHP.FileStorage.Config

Listing 61: Allow uploads

initStaticDirStorage

A simple file upload form is enough, everything in Activity can be derived from the uploaded TCX file.

Listing 62: Lay out Activity upload form

{(fileField #uploadUrl) { required = True }}
{submitButton}

Once the user has browsed for a file and clicks "Upload", we will pass the uploaded TCX for conversion. The file arrives at the CreateActivityAction. User will be redirected back to the front page after the file has been processed server-side. The TCX file is converted into an intermediate TcxActivity and finally to an Activity compatible with our model. An intermediate form is used as it is easier to parse XML into a rose tree-like record than a database-style inverted tree.

Listing 63: Create Activity from uploaded TCX

action CreateActivityAction = do
  <<Convert uploaded TCX into TcxActivity>>
  activityId <- (\x -> x.id) <$> insertTcxActivity tcx
  setSuccessMessage ("Activity uploaded!")
  redirectTo $ ShowActivityAction { .. }

The TCX file we've received is an XML-formatted file. In the file, Trackpoints are of most interest as it keeps track of heart rate, speed and time, but Lap and Activity have some useful metadata too. We have to expect that occasionally any other field than Time can be missing, as even heart rate might not be included in first couple Trackpoint nodes. An example TCX produced by a 5-second strength training workout.

Listing 64: Test/test.strength.tcx

<?xml version="1.0" encoding="UTF-8"?>
<TrainingCenterDatabase xmlns="http://www.garmin.com/xmlschemas/TrainingCenterDatabase/v2">
  <Activities>
    <Activity Sport="Other">
      <Id>2024-03-19T12:28:24.470Z</Id>
      <Lap StartTime="2024-03-19T12:28:25.470Z">
        <TotalTimeSeconds>5.0</TotalTimeSeconds>
        <DistanceMeters>0.0</DistanceMeters>
        <Calories>1</Calories>
        <AverageHeartRateBpm>
          <Value>61</Value>
        </AverageHeartRateBpm>
        <MaximumHeartRateBpm>
          <Value>61</Value>
        </MaximumHeartRateBpm>
        <Intensity>Active</Intensity>
        <TriggerMethod>Manual</TriggerMethod>
        <Track>
          <Trackpoint>
            <Time>2024-03-19T12:28:25.470Z</Time>
            <SensorState>Present</SensorState>
          </Trackpoint>
          <Trackpoint>
            <Time>2024-03-19T12:28:26.470Z</Time>
            <SensorState>Present</SensorState>
          </Trackpoint>
          <Trackpoint>
            <Time>2024-03-19T12:28:27.470Z</Time>
            <HeartRateBpm>
              <Value>61</Value>
            </HeartRateBpm>
            <SensorState>Present</SensorState>
          </Trackpoint>
          <Trackpoint>
            <Time>2024-03-19T12:28:28.470Z</Time>
            <HeartRateBpm>
              <Value>61</Value>
            </HeartRateBpm>
            <SensorState>Present</SensorState>
          </Trackpoint>
          <Trackpoint>
            <Time>2024-03-19T12:28:29.470Z</Time>
            <HeartRateBpm>
              <Value>61</Value>
            </HeartRateBpm>
            <SensorState>Present</SensorState>
          </Trackpoint>
        </Track>
      </Lap>
      <Training VirtualPartner="false">
        <Plan Type="Workout" IntervalWorkout="false">
          <Extensions/>
        </Plan>
      </Training>
      <Creator xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="Device_t">
        <Name>Polar INW3N_V2</Name>
        <UnitId>0</UnitId>
        <ProductID>0</ProductID>
        <Version>
          <VersionMajor>0</VersionMajor>
          <VersionMinor>0</VersionMinor>
          <BuildMajor>0</BuildMajor>
          <BuildMinor>0</BuildMinor>
        </Version>
      </Creator>
    </Activity>
  </Activities>
  <Author xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="Application_t">
    <Name>https://github.com/cmaion/polar</Name>
    <Build>
      <Version>
        <VersionMajor>0</VersionMajor>
        <VersionMinor>0</VersionMinor>
      </Version>
    </Build>
    <LangID>EN</LangID>
    <PartNumber>XXX-XXXXX-XX</PartNumber>
  </Author>
</TrainingCenterDatabase>

Another truncated example of a walking workout. Note that sport is "Other" regardless if it is strength training (previous case) or walking (this case). Superfluous and identical with previous case, Author and Creator parts were cut out in this case to save your eyes. In the walking workout there is a peculiar edge case: as the watch auto-laps every 1000.0m, the last Lap will both lack some fields like heart rate statistics and have zero calories and cadence. As with previous case and this case, the XML's have been cut out from larger XML files and are not 100% authentic and shouldn't be taken as complete gospel.

Listing 65: Test/test.walking.tcx

<?xml version="1.0" encoding="UTF-8"?>
<TrainingCenterDatabase xmlns="http://www.garmin.com/xmlschemas/TrainingCenterDatabase/v2">
  <Activities>
    <Activity Sport="Other">
      <Id>2024-03-28T11:03:14.101Z</Id>
      <Lap StartTime="2024-03-28T11:03:15.101Z">
        <TotalTimeSeconds>2.0</TotalTimeSeconds>
        <DistanceMeters>3.7</DistanceMeters>
        <MaximumSpeed>1.8311089939541287</MaximumSpeed>
        <Calories>3</Calories>
        <AverageHeartRateBpm>
          <Value>73</Value>
        </AverageHeartRateBpm>
        <MaximumHeartRateBpm>
          <Value>73</Value>
        </MaximumHeartRateBpm>
        <Intensity>Active</Intensity>
        <Cadence>51</Cadence>
        <TriggerMethod>Distance</TriggerMethod>
        <Track>
          <Trackpoint>
            <Time>2024-03-28T11:03:15.101Z</Time>
            <Position>
              <LatitudeDegrees>61.44253</LatitudeDegrees>
              <LongitudeDegrees>23.85222667</LongitudeDegrees>
            </Position>
            <AltitudeMeters>158.193</AltitudeMeters>
            <DistanceMeters>0.0</DistanceMeters>
            <HeartRateBpm>
              <Value>73</Value>
            </HeartRateBpm>
            <Cadence>0</Cadence>
            <SensorState>Present</SensorState>
          </Trackpoint>
          <Trackpoint>
            <Time>2024-03-28T11:03:16.101Z</Time>
            <Position>
              <LatitudeDegrees>61.44255</LatitudeDegrees>
              <LongitudeDegrees>23.85222</LongitudeDegrees>
            </Position>
            <AltitudeMeters>158.193</AltitudeMeters>
            <DistanceMeters>0.0</DistanceMeters>
            <HeartRateBpm>
              <Value>73</Value>
            </HeartRateBpm>
            <Cadence>0</Cadence>
            <SensorState>Present</SensorState>
          </Trackpoint>
          <Trackpoint>
            <Time>2024-03-28T11:03:17.101Z</Time>
            <Position>
              <LatitudeDegrees>61.44256333</LatitudeDegrees>
              <LongitudeDegrees>23.85222833</LongitudeDegrees>
            </Position>
            <AltitudeMeters>158.193</AltitudeMeters>
            <DistanceMeters>0.0</DistanceMeters>
            <HeartRateBpm>
              <Value>73</Value>
            </HeartRateBpm>
            <Cadence>0</Cadence>
            <SensorState>Present</SensorState>
          </Trackpoint>
        </Track>
      </Lap>
      <Lap StartTime="2024-03-28T11:52:28.854Z">
        <TotalTimeSeconds>2.58500000000004</TotalTimeSeconds>
        <DistanceMeters>3.439990234375</DistanceMeters>
        <Calories>0</Calories>
        <Intensity>Active</Intensity>
        <TriggerMethod>Distance</TriggerMethod>
        <Track>
          <Trackpoint>
            <Time>2024-03-28T11:52:28.854Z</Time>
            <AltitudeMeters>161.089</AltitudeMeters>
            <DistanceMeters>3003.800048828125</DistanceMeters>
            <HeartRateBpm>
              <Value>106</Value>
            </HeartRateBpm>
            <Cadence>55</Cadence>
            <SensorState>Present</SensorState>
          </Trackpoint>
          <Trackpoint>
            <Time>2024-03-28T11:52:29.854Z</Time>
            <AltitudeMeters>161.089</AltitudeMeters>
            <DistanceMeters>3005.10009765625</DistanceMeters>
            <HeartRateBpm>
              <Value>107</Value>
            </HeartRateBpm>
            <Cadence>55</Cadence>
            <SensorState>Present</SensorState>
          </Trackpoint>
        </Track>
      </Lap>
      <Training VirtualPartner="false">
        <Plan Type="Workout" IntervalWorkout="false">
          <Extensions/>
        </Plan>
      </Training>
      <Creator xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="Device_t">
        <Name>Polar INW3N_V2</Name>
      </Creator>
    </Activity>
  </Activities>
</TrainingCenterDatabase>

The following type structures are directly derived from thes two XML structures with uninteresting data pruned out. We end up with a tree structure going from Activity, to Lap, to Trackpoint. Intermediate types are prefixed by 'Tcx' to avoid collisions with IHP's database-derived types. Activity's intermediate type:

Listing 66: TcxActivity

data TcxActivity = TcxActivity
  { tcxLaps :: [TcxLap]
  , tcxSport :: Text
  , tcxActStart :: UTCTime
  , tcxPlanType :: Text
  , tcxDeviceName :: Text
  } deriving (Eq, Show)

And the database schema for Activity derived from it:

Listing 67: Activity schema

CREATE TABLE activities (
    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
    sport TEXT NOT NULL,
    start_time TIMESTAMP WITH TIME ZONE NOT NULL,
    plan_type TEXT NOT NULL,
    device_name TEXT NOT NULL,
    upload_url TEXT NOT NULL
);

Activities consist of one or more Laps.

Listing 68: TcxLap

data TcxLap = TcxLap
  { tcxTrack :: TcxTrack
  , tcxLapStart :: UTCTime
  , tcxLapTotal :: TotalTimeSec
  , tcxLapDistance :: DistanceMeters
  , tcxMaxSpeed :: Maybe Float
  , tcxCals :: Calories
  , tcxAvgHR :: Maybe HeartRateBpm
  , tcxMaxHR :: Maybe HeartRateBpm
  , tcxIntensity :: Text
  , tcxLapCadence :: Maybe Int
  , tcxTrigger :: Text
  } deriving (Eq, Show)

Listing 69: Lap schema

CREATE TABLE laps (
    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
    activity_id UUID NOT NULL,
    start_time TIMESTAMP WITH TIME ZONE NOT NULL,
    total_time REAL NOT NULL,
    distance REAL NOT NULL,
    maximum_speed REAL DEFAULT NULL,
    calories INT NOT NULL,
    average_hr INT DEFAULT NULL,
    maximum_hr INT DEFAULT NULL,
    intensity TEXT NOT NULL,
    cadence INT DEFAULT NULL,
    "trigger" TEXT NOT NULL
);

Laps in turn consist of tracks which are collections of Trackpoints. We will assume any extra tracks can be concatenated into one single track to simplify the data model.

Listing 70: TcxTrackpoint

data TcxTrackpoint = TcxTrackpoint
  { tcxTpTime :: UTCTime
  , tcxLatitude :: Maybe Float
  , tcxLongitude :: Maybe Float
  , tcxAltitude :: Maybe DistanceMeters
  , tcxTpDistance :: Maybe DistanceMeters
  , tcxTpHR :: Maybe HeartRateBpm
  , tcxCadence :: Maybe Int
  , tcxSensor :: Text
  } deriving (Eq, Show)

type TcxTrack = [TcxTrackpoint]

Listing 71: Trackpoint schema

CREATE TABLE trackpoints (
    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
    lap_id UUID NOT NULL,
    point_time TIMESTAMP WITH TIME ZONE NOT NULL,
    latitude REAL DEFAULT NULL,
    longitude REAL DEFAULT NULL,
    altitude REAL DEFAULT NULL,
    point_distance REAL DEFAULT NULL,
    hr INT DEFAULT NULL,
    cadence INT DEFAULT NULL,
    sensor TEXT NOT NULL
);

We collect these along with some descriptive aliases into types for the application.

Listing 72: Tcx types

type TotalTimeSec = Float
type DistanceMeters = Float
type Calories = Int
type HeartRateBpm = Int

<<TcxTrackpoint>>

<<TcxLap>>

<<TcxActivity>>

Listing 73: Tcx schema

<<Activity schema>>
<<Lap schema>>
<<Trackpoint schema>>

With these types, the strength training TCX file should then parse into a structure like this.

Listing 74: Truncated strength training TCX XML parsed into a record

[ TcxActivity
  { tcxLaps =
    [ TcxLap
      { tcxTrack =
        [ TcxTrackpoint
          { tcxTpTime = 2024-03-19 12:28:25.47 UTC
          , tcxLatitude = Nothing
          , tcxLongitude = Nothing
          , tcxAltitude = Nothing
          , tcxTpDistance = Nothing
          , tcxTpHR = Nothing
          , tcxCadence = Nothing
          , tcxSensor = "Present"
          }
        , TcxTrackpoint
          { tcxTpTime = 2024-03-19 12:28:26.47 UTC
          , tcxLatitude = Nothing
          , tcxLongitude = Nothing
          , tcxAltitude = Nothing
          , tcxTpDistance = Nothing
          , tcxTpHR = Nothing
          , tcxCadence = Nothing
          , tcxSensor = "Present"
          }
        , TcxTrackpoint
          { tcxTpTime = 2024-03-19 12:28:27.47 UTC
          , tcxLatitude = Nothing
          , tcxLongitude = Nothing
          , tcxAltitude = Nothing
          , tcxTpDistance = Nothing
          , tcxTpHR = Just 61
          , tcxCadence = Nothing
          , tcxSensor = "Present"
          }
        , TcxTrackpoint
          { tcxTpTime = 2024-03-19 12:28:28.47 UTC
          , tcxLatitude = Nothing
          , tcxLongitude = Nothing
          , tcxAltitude = Nothing
          , tcxTpDistance = Nothing
          , tcxTpHR = Just 61
          , tcxCadence = Nothing
          , tcxSensor = "Present"
          }
        , TcxTrackpoint
          { tcxTpTime = 2024-03-19 12:28:29.47 UTC
          , tcxLatitude = Nothing
          , tcxLongitude = Nothing
          , tcxAltitude = Nothing
          , tcxTpDistance = Nothing
          , tcxTpHR = Just 61
          , tcxCadence = Nothing
          , tcxSensor = "Present"
          }
        ]
      , tcxLapStart = 2024-03-19 12:28:25.47 UTC
      , tcxLapTotal = 5.0
      , tcxLapDistance = 0.0
      , tcxMaxSpeed = Nothing
      , tcxCals = 1
      , tcxAvgHR = Just 61
      , tcxMaxHR = Just 61
      , tcxIntensity = "Active"
      , tcxLapCadence = Nothing
      , tcxTrigger = "Manual"
      }
    ]
  , tcxSport = "Other"
  , tcxActStart = 2024-03-19 12:28:24.47 UTC
  , tcxPlanType = "Workout"
  , tcxDeviceName = "Polar INW3N_V2"
  }
]

TcxActivity's Show instance would then produce this for comparison test:

Listing 75: Test/test.strength.tcx.result

[TcxActivity {tcxLaps = [TcxLap {tcxTrack = [TcxTrackpoint {tcxTpTime = 2024-03-19 12:28:25.47 UTC, tcxLatitude = Nothing, tcxLongitude = Nothing, tcxAltitude = Nothing, tcxTpDistance = Nothing, tcxTpHR = Nothing, tcxCadence = Nothing, tcxSensor = "Present"},TcxTrackpoint {tcxTpTime = 2024-03-19 12:28:26.47 UTC, tcxLatitude = Nothing, tcxLongitude = Nothing, tcxAltitude = Nothing, tcxTpDistance = Nothing, tcxTpHR = Nothing, tcxCadence = Nothing, tcxSensor = "Present"},TcxTrackpoint {tcxTpTime = 2024-03-19 12:28:27.47 UTC, tcxLatitude = Nothing, tcxLongitude = Nothing, tcxAltitude = Nothing, tcxTpDistance = Nothing, tcxTpHR = Just 61, tcxCadence = Nothing, tcxSensor = "Present"},TcxTrackpoint {tcxTpTime = 2024-03-19 12:28:28.47 UTC, tcxLatitude = Nothing, tcxLongitude = Nothing, tcxAltitude = Nothing, tcxTpDistance = Nothing, tcxTpHR = Just 61, tcxCadence = Nothing, tcxSensor = "Present"},TcxTrackpoint {tcxTpTime = 2024-03-19 12:28:29.47 UTC, tcxLatitude = Nothing, tcxLongitude = Nothing, tcxAltitude = Nothing, tcxTpDistance = Nothing, tcxTpHR = Just 61, tcxCadence = Nothing, tcxSensor = "Present"}], tcxLapStart = 2024-03-19 12:28:25.47 UTC, tcxLapTotal = 5.0, tcxLapDistance = 0.0, tcxMaxSpeed = Nothing, tcxCals = 1, tcxAvgHR = Just 61, tcxMaxHR = Just 61, tcxIntensity = "Active", tcxLapCadence = Nothing, tcxTrigger = "Manual"}], tcxSport = "Other", tcxActStart = 2024-03-19 12:28:24.47 UTC, tcxPlanType = "Workout", tcxDeviceName = "Polar INW3N_V2"}]

Similarly, the walking workout should then produce this.

Listing 76: Test/test.walking.tcx.result

[TcxActivity {tcxLaps = [TcxLap {tcxTrack = [TcxTrackpoint {tcxTpTime = 2024-03-28 11:03:15.101 UTC, tcxLatitude = Just 61.44253, tcxLongitude = Just 23.852226, tcxAltitude = Just 158.193, tcxTpDistance = Just 0.0, tcxTpHR = Just 73, tcxCadence = Just 0, tcxSensor = "Present"},TcxTrackpoint {tcxTpTime = 2024-03-28 11:03:16.101 UTC, tcxLatitude = Just 61.44255, tcxLongitude = Just 23.85222, tcxAltitude = Just 158.193, tcxTpDistance = Just 0.0, tcxTpHR = Just 73, tcxCadence = Just 0, tcxSensor = "Present"},TcxTrackpoint {tcxTpTime = 2024-03-28 11:03:17.101 UTC, tcxLatitude = Just 61.442562, tcxLongitude = Just 23.852228, tcxAltitude = Just 158.193, tcxTpDistance = Just 0.0, tcxTpHR = Just 73, tcxCadence = Just 0, tcxSensor = "Present"}], tcxLapStart = 2024-03-28 11:03:15.101 UTC, tcxLapTotal = 2.0, tcxLapDistance = 3.7, tcxMaxSpeed = Just 1.831109, tcxCals = 3, tcxAvgHR = Just 73, tcxMaxHR = Just 73, tcxIntensity = "Active", tcxLapCadence = Just 51, tcxTrigger = "Distance"},TcxLap {tcxTrack = [TcxTrackpoint {tcxTpTime = 2024-03-28 11:52:28.854 UTC, tcxLatitude = Nothing, tcxLongitude = Nothing, tcxAltitude = Just 161.089, tcxTpDistance = Just 3003.8, tcxTpHR = Just 106, tcxCadence = Just 55, tcxSensor = "Present"},TcxTrackpoint {tcxTpTime = 2024-03-28 11:52:29.854 UTC, tcxLatitude = Nothing, tcxLongitude = Nothing, tcxAltitude = Just 161.089, tcxTpDistance = Just 3005.1, tcxTpHR = Just 107, tcxCadence = Just 55, tcxSensor = "Present"}], tcxLapStart = 2024-03-28 11:52:28.854 UTC, tcxLapTotal = 2.585, tcxLapDistance = 3.4399903, tcxMaxSpeed = Nothing, tcxCals = 0, tcxAvgHR = Nothing, tcxMaxHR = Nothing, tcxIntensity = "Active", tcxLapCadence = Nothing, tcxTrigger = "Distance"}], tcxSport = "Other", tcxActStart = 2024-03-28 11:03:14.101 UTC, tcxPlanType = "Workout", tcxDeviceName = "Polar INW3N_V2"}]

First we'll convert the uploaded XML into the TcxActivity record type. TCX files can theoretically have multiple Activities, but they are not expected in this case. Neither is graceful exception handling required due to threaded nature of IHP and the singular purpose of the upload request, so using fromJust as a shortcut is fine for now.

Listing 77: Convert uploaded TCX into TcxActivity

let tcx :: TcxActivity =
      fileOrNothing "uploadUrl"
      |> fromMaybe (error "no file given")
      |> (.fileContent)
      |> cs
      |> processTcxUpload
      |> head
      |> fromJust

The external functions used in these conversions. Using fromJust is fine in cases where we can expect XML to be correctly formed and in malformed cases the silent error is not an issue. The service will keep on running in these cases.

Listing 78: Import TCX conversion functions

import Application.TCX (processTcxUpload)
import Data.Maybe (fromJust)

Since there are no libraries available for directly extracting the TCX format, we'll construct a filter chain using xml-conduit (Text.XML and Text.XML.Cursor).

Listing 79: Haskell dependencies

xml-conduit

Listing 80: Application/TCX.hs

{-# LANGUAGE OverloadedStrings #-}

module Application.TCX (processTcxFile, processTcxUpload) where

import Data.Maybe (fromJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TLIO
import Data.Time (UTCTime)
import Data.Time.Format.ISO8601 (formatParseM, iso8601Format)
import Text.XML
import Text.XML.Cursor

import IHP.Prelude
import Text.Read (readMaybe)
import Web.Types

<<Key TCX functions>>

<<The TCX inner works>>

There are two entry points to this TCX extractor: processTcxFile and processTcxUpload. Either approach would be fine with IHP's file uploading routine, but converting from Text rather than from FilePath inside IO monad is more straightforward. XML extractors like Haskell XML Toolkit only work with files, so having processTcxFile is fulfilling idiomatic expectations, but also enables testing with larger files.

Listing 81: Key TCX functions

processTcxFile :: FilePath -> IO [TcxActivity]
processTcxFile file = processTcx <$> TLIO.readFile file

processTcxUpload :: Text -> [TcxActivity]
processTcxUpload = processTcx . TL.pack . T.unpack

processTcx :: TL.Text -> [TcxActivity]
processTcx = getActivities . fromDocument . parseText_ def

Extracting the fields in this case is logically simple if repetitive and verbose. It could be cleaned up with some helper functions. read is used, but as before, graceful exception handling is not required here, although could be relatively easily added since the return value of [TcxActivity] is essentially a Maybe structure.

Listing 82: The TCX inner works

getActivities :: Cursor -> [TcxActivity]
getActivities cr =
  let activitiesCr = child cr >>= laxElement "Activities" >>= child >>= laxElement "Activity"
  in map getActivity activitiesCr

getActivity :: Cursor -> TcxActivity
getActivity cr =
  let lapsCr = child cr >>= laxElement "Lap"
      startTime = readTime . T.concat $ child cr >>= laxElement "Id" >>= descendant >>= content
  in TcxActivity
     (map getLap lapsCr)
     (T.concat $ attribute "Sport" cr)
     startTime
     (T.concat $ child cr >>= laxElement "Training" >>= child >>= laxElement "Plan" >>= attribute "Type")
     (T.concat $ child cr >>= laxElement "Creator" >>= child >>= laxElement "Name" >>= child >>= content)

getLap :: Cursor -> TcxLap
getLap cr =
  let tracksCr = child cr >>= laxElement "Track" >>= child >>= laxElement "Trackpoint"
  in TcxLap
     (map getTrackpoint tracksCr)
     (readTime . T.concat $ attribute "StartTime" cr)
          (fromJust . readContent $ child cr >>= laxElement "TotalTimeSeconds" >>= child >>= content)
     (fromJust . readContent $ child cr >>= laxElement "DistanceMeters" >>= child >>= content)
     (readContent $ child cr >>= laxElement "MaximumSpeed" >>= child >>= content)
     (fromJust . readContent $ child cr >>= laxElement "Calories" >>= child >>= content)
     (readContent $ child cr >>= laxElement "AverageHeartRateBpm" >>= child >>= laxElement "Value" >>= child >>= content)
     (readContent $ child cr >>= laxElement "MaximumHeartRateBpm" >>= child >>= laxElement "Value" >>= child >>= content)
     (T.concat $ child cr >>= laxElement "Intensity" >>= child >>= content)
     (readContent $ child cr >>= laxElement "Cadence" >>= child >>= content)
     (T.concat $ child cr >>= laxElement "TriggerMethod" >>= child >>= content)


getTrackpoint :: Cursor -> TcxTrackpoint
getTrackpoint cr =
  TcxTrackpoint
  (readTime . T.concat $ child cr >>= laxElement "Time" >>= child >>= content)
  (readContent $ child cr >>= laxElement "Position" >>= child >>= laxElement "LatitudeDegrees" >>= child >>= content)
  (readContent $ child cr >>= laxElement "Position" >>= child >>= laxElement "LongitudeDegrees" >>= child >>= content)
  (readContent $ child cr >>= laxElement "AltitudeMeters" >>= child >>= content)
  (readContent $ child cr >>= laxElement "DistanceMeters" >>= child >>= content)
  (readContent $ child cr >>= laxElement "HeartRateBpm" >>= child >>= laxElement "Value" >>= child >>= content)
  (readContent $ child cr >>= laxElement "Cadence" >>= child >>= content)
  (T.concat $ child cr >>= laxElement "SensorState" >>= child >>= content)


readContent :: (Read a) => [Text] -> Maybe a
readContent = readMaybe . T.unpack . T.concat

readTime :: Text -> UTCTime
readTime = fromJust . formatParseM iso8601Format . T.unpack

Having put all this together, we can now convert a TCX file into a Haskell record structure:

:l Test/Main
hspec $ Test.Application.TCXSpec.tcxToRecord

Then we can do a type conversion similar to the one we did in when reading the XML: converting from the intermediate TcxActivity into the Activity and others, which are then saved in the database via createRecord and its merged INSERT variation createMany. IHP will then be using Activity, Lap and Trackpoint in the views.

Listing 83: Convert TcxActivity into Activity and other database records

insertTcxActivity :: (?modelContext::ModelContext) => TcxActivity -> IO Activity
insertTcxActivity tcx = do
  activity <- newRecord @Activity
              |> set #sport (tcxSport tcx)
              |> set #startTime (tcxActStart tcx)
              |> set #planType (tcxPlanType tcx)
              |> set #deviceName (tcxDeviceName tcx)
              |> createRecord
  laps <- createMany $ map (\lap -> newRecord @Lap
                                    |> set #activityId (unpackId activity.id)
                                    |> set #startTime (tcxLapStart lap)
                                    |> set #totalTime (tcxLapTotal lap)
                                    |> set #distance (tcxLapDistance lap)
                                    |> set #maximumSpeed (tcxMaxSpeed lap)
                                    |> set #calories (tcxCals lap)
                                    |> set #averageHr (tcxAvgHR lap)
                                    |> set #maximumHr (tcxMaxHR lap)
                                    |> set #intensity (tcxIntensity lap)
                                    |> set #cadence (tcxLapCadence lap)
                                    |> set #trigger (tcxTrigger lap)
                           ) (tcxLaps tcx)
  let lapIdsWithTracks = zip (map (.id) laps) (map tcxTrack $ tcxLaps tcx)
  mapM_ (\(lapId, tcks) ->
           createMany $ map (\tck -> newRecord @Trackpoint
                                     |> set #lapId (unpackId lapId)
                                     |> set #pointTime (tcxTpTime tck)
                                     |> set #latitude (tcxLatitude tck)
                                     |> set #longitude (tcxLongitude tck)
                                     |> set #altitude (tcxAltitude tck)
                                     |> set #pointDistance (tcxTpDistance tck)
                                     |> set #hr (tcxTpHR tck)
                                     |> set #cadence (tcxCadence tck)
                                     |> set #sensor (tcxSensor tck)
                            ) tcks
        ) lapIdsWithTracks
  return activity

:l Test/Main
hspec $ Test.Application.Spec.tcxToRecord

These two conversions then come together and with the results saved into database with createRecord and createMany earlier, we can congratulate the user and show them the uploaded Activity.

:l Test/Controller/ActivitiesSpec.hs
hspec $ aroundAll (withIHPApp WebApplication config) $ Test.Controller.ActivitiesSpec.testTcxUpload

User looks at an activity

User opens the main view and either the newest activity or one they selected pops into their view. Details about their heart rate, heart rate zones, speed, and cadence along with total distance moved come into their view. Each new lap should be indicated in the graph. The graphs and info can be seen in the united interface mock-up.

Propositions

In this part of the story, we'll have to consider how to visualize the data for the user, and how to get the data in a suitable form for proper visualization. We will use one chart for heart rate, its zones, speed and cadence, another smaller donut chart for visualizing the zones, and a small table for total distance, time, maybe calories and other tidbits in case the user suddenly comes up with new requirements

The charts and table should look like in the united interface mock-up.

To fetch and sculpt the required data properly, these tests should pass.

Listing 84: Test/Controller/ActivitiesSpec.hs

testChartData = do
  describe "ActivitiesController" $ do
    it "fetches data" $ withContext do
      deleteAll @Activity
      (activity, laps, tps) <- query @Activity |> fetchOneOrNothing >>= queryActivityAndItsChildren
      (isJust activity) `shouldBe` False
      laps `shouldBe` []
      tps `shouldBe` [[]]
      createFauxActivity
      (justActivity, justLaps, justTps) <- query @Activity |> fetchOneOrNothing >>= queryActivityAndItsChildren
      (isJust justActivity) `shouldBe` True
      length justLaps `shouldBe` 1
      length (concat justTps) `shouldBe` 5
    it "sculpts the data as intended for charts" $ withContext do
      deleteAll @Activity
      createFauxActivity
      (activity, laps, tps) <- query @Activity |> fetchOneOrNothing >>= queryActivityAndItsChildren
      let hrSeries = map hr (concat tps)
      hrSeries `shouldBe` [Nothing, Nothing, Just 61, Just 61, Just 61]
      let avgHr = avgOver10s $ map (fromIntegral . fromMaybe 0) hrSeries
      avgHr `shouldBe` [36.6] -- Nothing is read as 0.0, we want to keep list length in line with time
    it "shows a selected activity" $ withContext do
      deleteAll @HealthInformation
      insertDefaultHealthInformation
      deleteAll @Activity
      createFauxActivity
      activity <- query @Activity |> fetchOne
      response <- callAction $ ShowActivityAction { activityId = activity.id }
      response `responseStatusShouldBe` status200
      response `responseBodyShouldContain` ("Showing a " ++ (activity.planType) ++ " from " ++ (show $ activity.startTime))
  where
    createFauxActivity :: (?modelContext::ModelContext) => IO Activity
    createFauxActivity =
      fromJust . head <$> processTcxFile "Test/test.strength.tcx" >>= insertTcxActivity

Listing 85: ActivitiesSpec test function calls

testChartData

Implementation

Plotting the activity

We'll be using an external chart.js library for plotting the data points. We'll amend Web/View/Layout.hs to include it.

Listing 86: Import JavaScript libraries

<script src={assetPath "/chart.umd.min.js"}></script>

There are 5 different data types to chart over time. Ideally these would fit in a single chart. Heart rate and heart rate zones, speed and cadence, and laps are quite interrelated. We will get a set of labels (time), and matching datasets of the 5 data types. Let's start with the main plotting JavaScript script block. We'll fill in labels and dataset data later using another client-side block, we're now more concerned about how the data should be presented.

Listing 87: Plot selected activity

<script id="activityPlotter"
data-heartrate={cdHeartRate chartData}
data-heartratezone1={(\(x,a,b,c,d) -> x) (cdHeartRateZones chartData)}
data-heartratezone2={(\(a,x,b,c,d) -> x) (cdHeartRateZones chartData)}
data-heartratezone3={(\(a,b,x,c,d) -> x) (cdHeartRateZones chartData)}
data-heartratezone4={(\(a,b,c,x,d) -> x) (cdHeartRateZones chartData)}
data-heartratezone5={(\(a,b,c,d,x) -> x) (cdHeartRateZones chartData)}
data-speed={cdSpeed chartData}
data-cadence={cdCadence chartData}
data-laps={cdLaps chartData}
data-time={cdTime chartData}
data-totaltime={cdTotalTime chartData}>
var ctx = document.getElementById("activityChart").getContext('2d');
var aPChart = new Chart(ctx, {
  data: {
    labels: [],
    datasets: [
        <<Plot heart rate>>
        ,
        <<Plot speed>>
        ,
        <<Plot cadence>>
        ,
        <<Plot laps>>
        ,
        <<Plot heart rate zones>>
        ]
      },
  options: {
    normalized: true,
    aspectRatio: 1,
    scales: {
      <<Scale heart rate>>
      ,
      <<Scale time>>
    },
    <<Filter out heart rate zone legends>>
  }
});
</script>

To plot and scale heart rates, following structures should do:

Listing 88: Plot heart rate

{
  type: 'line',
  label: 'Heart rate',
  data: [],
  fill: false,
  borderColor: 'rgb(192, 75, 75)',
  pointStyle: false,
  tension: 0.1,
  yAxisID: 'bpmY',
}

To visualize the user's descent into old age, we'll always keep the maximum heart rate scale at the theoretical 20yo's maximum of 200 BPM. A common maximum is needed to visualize differences between exercises.

Listing 89: Scale heart rate

bpmY: {
  min: 0,
  max: 200,
  position: 'left',
  title: {
    display: true,
    text: 'BPM, RPM, Km/h',
  },
  grid: {
    color: 'rgb(255,255,255)'
  }
}

The heart rate zones require a bit of a different approach. Ideally we would paint Y axis partitioned into zones with respective colors, but straight lines delineating the zones should do also. We need to make 5 distinct zones.

Listing 90: Plot heart rate zones

{
  type: 'line',
  label: '50% zone',
  data: [],
  fill: true,
  backgroundColor: 'rgba(128, 192, 255, 0.5)',
  pointStyle: false,
  tension: 0,
  yAxisID: 'bpmY',
  showLine: false
},
{
  type: 'line',
  label: '60% zone',
  data: [],
  fill: true,
  backgroundColor: 'rgba(192, 192, 255, 0.5)',
  pointStyle: false,
  tension: 0,
  yAxisID: 'bpmY',
  showLine: false
},
{
  type: 'line',
  label: '70% zone',
  data: [],
  fill: true,
  backgroundColor: 'rgba(192, 224, 224, 0.5)',
  pointStyle: false,
  tension: 0.1,
  yAxisID: 'bpmY',
  showLine: false
},
{
  type: 'line',
  label: '80% zone',
  data: [],
  fill: true,
  backgroundColor: 'rgba(255, 255, 192, 0.5)',
  pointStyle: false,
  tension: 0,
  yAxisID: 'bpmY',
  showLine: false
},
{
  type: 'line',
  label: '90% zone',
  data: [],
  fill: true,
  backgroundColor: 'rgba(255, 160, 160, 0.5)',
  pointStyle: false,
  tension: 0,
  yAxisID: 'bpmY',
  showLine: false
}

To avoid littering the legends table, we will filter out the useless heart rate zone legends.

Listing 91: Filter out heart rate zone legends

plugins: {
  legend: {
    labels: {
      filter: item => (item.text !== '50% zone'
                       && item.text !== '60% zone'
                       && item.text !== '70% zone'
                       && item.text !== '80% zone'
                       && item.text !== '90% zone')
    }
  },
  tooltip: {
    filter: item => (item.datasetIndex !== 4
                     && item.datasetIndex !== 5
                     && item.datasetIndex !== 6
                     && item.datasetIndex !== 7
                     && item.datasetIndex !== 8)
  }
}

Speed is similar to heart rate, ~~but uses a different axis~~ all use the same 0-200 axis for simplicity of a kind. 200 km/h or rpm seems like a sensible maximum for both speed and cadence to have them visually separate from heart rate and each other, but still be distinguishable even at around 5 km/h.

Listing 92: Plot speed

{
  type: 'line',
  label: 'Speed',
  data: [],
  fill: false,
  borderColor: 'rgb(255, 255, 64)',
  pointStyle: false,
  tension: 0.1,
  yAxisID: 'bpmY'
}

The unused speed axis:

Listing 93: Scale speed

speedY: {
  min: 0,
  max: 200,
  position: 'right',
  title: {
    display: true,
    text: 'Km/h',
  }
}

Cadence goes in with speed.

Listing 94: Plot cadence

{
  type: 'line',
  label: 'Cadence',
  data: [],
  fill: false,
  borderColor: 'rgb(64, 160, 64)',
  pointStyle: false,
  tension: 0.1,
  yAxisID: 'bpmY'
}

Finally, laps will be (for now) implemented with simple dots using a scatter type. We'll make the dots appear on top of the heart rate dataset, as it is found on all activities.

Listing 95: Plot laps

{
  type: 'scatter',
  label: 'Lap',
  data: [],
  fill: false,
  borderColor: 'rgb(128, 128, 128)',
  pointStyle: 'circle',
  radius: 10,
  tension: 0.1,
  yAxisID: 'bpmY',
  xAxisID: 'x'
}

Everything above then is shown as a function of time. It's obvious from labels what it is, so no separate title is required.

Listing 96: Scale time

x: {
  min: 0,
  title: {
    display: false,
    text: 'Time'
  },
  grid: {
    color: 'rgb(255,255,255)'
  }
}

This will then show up on a canvas.

Listing 97: Show plotted activity

<div style="position: relative;"><canvas id="activityChart"></canvas></div>

We can then put it all together

Listing 98: Lay out selected activity

<<Show plotted activity>>
<<Plot selected activity>>

Frontend will receive the data in a JSON parseable format. The chart is filled & updated with data clientside due to some quirks regarding the single-page nature of the frontend. Fully serverside, the chart would have trouble updating when moving between activities, even if the data-fields in <script> would update.

IHP has a premade JS function that runs on every page load and as turbolinks change it:

Listing 99: static/app.js

$(document).on('ready turbolinks:load', function () {
  <<Update chart>>
    // This is called on the first page load *and* also when the page is changed by turbolinks
});

We'll then update the chart:

Listing 100: Update chart

var plotter = document.getElementById('activityPlotter');
aPChart.data.datasets[0].data = JSON.parse(plotter.dataset.heartrate);
aPChart.data.datasets[1].data = JSON.parse(plotter.dataset.speed);
aPChart.data.datasets[2].data = JSON.parse(plotter.dataset.cadence);
aPChart.data.datasets[3].data = JSON.parse(plotter.dataset.laps);
aPChart.data.datasets[4].data = JSON.parse(plotter.dataset.heartratezone1);
aPChart.data.datasets[5].data = JSON.parse(plotter.dataset.heartratezone2);
aPChart.data.datasets[6].data = JSON.parse(plotter.dataset.heartratezone3);
aPChart.data.datasets[7].data = JSON.parse(plotter.dataset.heartratezone4);
aPChart.data.datasets[8].data = JSON.parse(plotter.dataset.heartratezone5);
aPChart.data.labels = JSON.parse(plotter.dataset.time);
aPChart.scales.x.max = JSON.parse(plotter.dataset.totaltime);
aPChart.update('none');
aPChart.resize();

We should now have a graphical presentation of the data done.

<<Chromium binary>> <<Chromium options>> "http://localhost:8000"
<<Post-process screenshot>> visualizations/ui_visualization.png

Next we'll transform the model data for the frontend.

Sculpting the data

We desperately need a type for the JSONified chart data

Listing 101: Type ChartData

data ChartData = ChartData
  { cdHeartRate :: Text
  , cdHeartRateZones :: (Text, Text, Text, Text, Text)
  , cdSpeed :: Text
  , cdCadence :: Text
  , cdLaps :: Text
  , cdTime :: Text
  , cdTotalTime :: Text
  }

We can then start working on sculpting the data. We can assume that any sequential pair of Trackpoints will have 1-second interval between them. Since Haskell lists will read as JSON and the coordinate JSON is easy to roll by hand, we can avoid using external JSON libraries. We'll start off with heart rate. All integers will turn into floats during sculpting. The resulting data will have each list item represent a 10 second period. heartRate is used in calculating lap indicators, so we'll show it when constructing ChartData.

Listing 102: Sculpt Activity into ChartData

chartActivityData :: HealthInformation -> (Maybe Activity, [Lap], [[Trackpoint]]) -> Maybe ChartData
chartActivityData _          (Nothing, _, _) = Nothing
chartActivityData healthInfo (Just activity, laps, tps) =
  let heartRate = avgOver10s (map (fromIntegral . fromMaybe 0 . hr) $ concat tps)
      <<Sculpt Activity into ChartData zones>>
      <<Sculpt Activity into ChartData speed and cadence>>
      <<Sculpt Activity into ChartData laps>>
      <<Sculpt Activity into ChartData time>>
  <<Sculpt Activity into ChartData end>>

<<avgOver10s>>

Average over 10 seconds, but last average might average over only 1-9 seconds.

Listing 103: avgOver10s

avgOver10s :: [Float] -> [Float]
avgOver10s x =
  let average x = sum x / (fromIntegral $ length x)
  in if length x > 10
     then average (take 10 x) : avgOver10s (drop 10 x)
     else average x : []

Then we'll work on heart rate zones. They have a simple spread based on deciles and a general rule on maximum heart rate being 220 minus your age BPM. As the zones are drawn as overlapping blocks, we'll start the 90% zone at 100%, 80% at 90%, etc.

Listing 104: Sculpt Activity into ChartData zones

topHeartRate = fromIntegral $ 220 - age healthInfo
heartRateZones = (show . replicate (length heartRate) . round $ topHeartRate * 0.6,
                  show . replicate (length heartRate) . round $ topHeartRate * 0.7,
                  show . replicate (length heartRate) . round $ topHeartRate * 0.8,
                  show . replicate (length heartRate) . round $ topHeartRate * 0.9,
                  show . replicate (length heartRate) . round $ topHeartRate * 1.0)

Speed requires some differential calculations. Cadence not so much.

Listing 105: Sculpt Activity into ChartData speed and cadence

speed = show . avgOver10s . deriveKmhSpeedFromDistance $ concat tps
cadence = show . avgOver10s $ map (\tp -> fromIntegral $ fromMaybe 0 tp.cadence) . concat $ tps

Listing 106: deriveKmhSpeedFromDistance

deriveKmhSpeedFromDistance :: [Trackpoint] -> [Float]
deriveKmhSpeedFromDistance (tp:[]) = []
deriveKmhSpeedFromDistance (tp1:tp2:tps) =
  case pointDistance tp1 of
    Just dist1 ->
      ((fromJust (pointDistance tp2) - dist1) * 3.6) : deriveKmhSpeedFromDistance (tp2:tps)
    Nothing ->
      0.0 : deriveKmhSpeedFromDistance (tp2:tps)

Now, laps, time, and total time will require dealing with Data.Time. We will have to calculate NominalDiffTimes from UTCTimes and put them on the chart.

Listing 107: Import Data.Time for sculpting ChartData

import Data.Time.Clock (diffUTCTime, nominalDiffTimeToSeconds)

With laps we need label for X axis and heart rate as of new lap for Y. X coordinate is the difference between activity and lap starts in seconds divided by 5 & nicely formatted. We get the label from time we're handling next. Y coordinate is current heart rate at that time. We don't need to know when the first lap started. We also need a more complex JSON than what the Show typeclass produces.

Listing 108: Sculpt Activity into ChartData laps

lapXCoordinate lap = floor (diffUTCTime (lap.startTime) (activity.startTime)) `div` 10 :: Int
newLaps = (\str -> T.concat["[", str, "]"]) . intercalate "," . map pack . drop 1 $
          map (\lap -> "{\"x\":\"" ++ unpack (time !! (lapXCoordinate lap)) ++
                       "\", \"y\":" ++ unpack (show (heartRate !! (lapXCoordinate lap))) ++ "}") laps

Time is then time.. averaged over 10 seconds (4.5, 14.5, .. as first trackpoint is at 0 seconds) But we'll cheat a bit and floor + remove 4 seconds from, so the chart starts at 00.00 with some nice formatting. time is used for totalTime, so it's show'd in the constructor.

Listing 109: Sculpt Activity into ChartData time

zeroPad t = pack (replicate (2 - length (unpack t)) '0' ++ (unpack t))
time = map (\t -> zeroPad (show (t `div` 60)) ++ ":"
                     ++ zeroPad (show (t `mod` 60))) $ map (\t -> floor t - 4) $ avgOver10s [0.0..(fromIntegral (length (concat tps) - 1))]
--time = map (\t -> floor t - 2) $ avgOver5s [0.0..(fromIntegral (length (concat tps) - 1))]

Total time is just the length of the X axis in this case.

Listing 110: Sculpt Activity into ChartData end

    totalTime = show . length $ time
in Just $ ChartData (show heartRate) heartRateZones speed cadence newLaps (show time) totalTime
where
  <<deriveKmhSpeedFromDistance>>

The data for sculpting is then fetched from the database.

Listing 111: Query Activity and its children

queryActivityAndItsChildren :: (?modelContext :: ModelContext) => Maybe Activity -> IO (Maybe Activity, [Lap], [[Trackpoint]])
queryActivityAndItsChildren maybeActivity = do
  case maybeActivity of
    Nothing ->
      return (Nothing, [], [[]])
    Just activity -> do
      laps <- query @Lap
              |> filterWhere (#activityId, unpackId activity.id)
              |> orderBy #startTime
              |> fetch
      tps <- mapM (\lap -> query @Trackpoint
                           |> filterWhere (#lapId, unpackId lap.id)
                           |> orderBy #pointTime
                           |> fetch
                  ) laps
      return (Just activity, laps, tps)

Everything in the backend is pulled together in ShowActivityAction

Listing 112: Show an activity

action ShowActivityAction { activityId } = do
  (selectedActivity, laps, tps) <- activityId |> fetchOneOrNothing >>= queryActivityAndItsChildren
  case selectedActivity of
    Nothing -> do
      setErrorMessage "Activity not found"
      redirectTo ActivitiesAction
    Just _ -> do
      activities <- query @Activity |> orderByDesc #startTime |> fetch
      healthInfo <- query @HealthInformation |> fetchOne
      let newActivity = newRecord
          chartData = chartActivityData healthInfo (selectedActivity, laps, tps)
      render IndexView { .. }

All propositions should now pass.

:l Test/Controller/ActivitiesSpec.hs
hspec $ aroundAll (withIHPApp WebApplication config) $ testChartData

User deletes an activity

User has clicked delete button and confirmed deletion. Activity and its constituents will be removed from the database.

Listing 113: Delete an activity

action DeleteActivityAction { activityId } = do
    (maybeActivity, laps, tps) <- activityId |> fetchOneOrNothing >>= queryActivityAndItsChildren
    case maybeActivity of
      Nothing -> do
        setErrorMessage "Activity not found"
        redirectTo ActivitiesAction
      Just activity -> do
        deleteRecord activity
        deleteRecords laps
        deleteRecords (concat tps)
        setSuccessMessage "Activity deleted"
        redirectTo ActivitiesAction

Boilerplate epilogue

Listing 114: Web/Types.hs

module Web.Types where

import IHP.Prelude
import IHP.ModelSupport
import Generated.Types

data WebApplication = WebApplication deriving (Eq, Show)

<<Tcx types>>

<<Type ActivitiesController>>

<<Type HealthInformationController>>

<<Type ChartData>>

Listing 115: Application/Helper/Controller.hs

module Application.Helper.Controller where

import IHP.ControllerPrelude

-- Here you can add functions which are available in all your controllers

Listing 116: Web/Routes.hs

module Web.Routes where
import IHP.RouterPrelude
import Generated.Types
import Web.Types

-- Generator Marker
<<Controller routing instances>>

Listing 117: Web/FrontController.hs

module Web.FrontController where

import IHP.RouterPrelude
import Web.Controller.Prelude
import Web.View.Layout (defaultLayout)

-- Controller Imports
<<Import controller actions>>

instance FrontController WebApplication where
    controllers =
        [ <<Set ActivitiesAction as front page>>
        -- Generator Marker
        <<Parse controller routes>>
        ]

instance InitControllerContext WebApplication where
    initContext = do
        setLayout defaultLayout
        initAutoRefresh

An SQL schema file is used to set up the database. Any further manipulation should be in the fixtures file below the schema, although fixtures don't get loaded in unit tests for some reason.

Listing 118: Application/Schema.sql

-- Your database schema. Use the Schema Designer at http://localhost:8001/ to add some tables.
<<Tcx schema>>
<<HealthInformation schema>>

Listing 119: Application/Fixtures.sql

<<Insert default HealthInformation row>>