about summary refs log tree commit diff
path: root/users/wpcarro/website/sandbox/learnpianochords
diff options
context:
space:
mode:
Diffstat (limited to 'users/wpcarro/website/sandbox/learnpianochords')
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/.envrc2
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/.gitignore3
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/README.md57
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/default.nix60
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/elm-srcs.nix67
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/elm.json30
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/ideas.org3
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/index.css3
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/index.html15
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/registry.datbin0 -> 93710 bytes
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/shell.nix10
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/FlashCard.elm42
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Icon.elm44
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Main.elm44
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Misc.elm59
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Overview.elm122
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Piano.elm194
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Practice.elm61
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Preferences.elm148
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Responsive.elm19
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/State.elm179
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Tailwind.elm29
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Tempo.elm33
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/Theory.elm1100
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/UI.elm159
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/.envrc6
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/.ghci7
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/API.hs16
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/App.hs57
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/Fixtures.hs67
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs111
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/Main.hs37
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/Spec.hs74
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/Stripe.hs29
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/TestUtils.hs17
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/Types.hs146
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/Utils.hs8
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/default.nix28
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/index.html35
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/init.sql41
-rw-r--r--users/wpcarro/website/sandbox/learnpianochords/src/server/shell.nix18
41 files changed, 3180 insertions, 0 deletions
diff --git a/users/wpcarro/website/sandbox/learnpianochords/.envrc b/users/wpcarro/website/sandbox/learnpianochords/.envrc
new file mode 100644
index 000000000000..a4a62da526d3
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/.envrc
@@ -0,0 +1,2 @@
+source_up
+use_nix
diff --git a/users/wpcarro/website/sandbox/learnpianochords/.gitignore b/users/wpcarro/website/sandbox/learnpianochords/.gitignore
new file mode 100644
index 000000000000..fd85a05d53d4
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/.gitignore
@@ -0,0 +1,3 @@
+/elm-stuff
+/Main.min.js
+/output.css
\ No newline at end of file
diff --git a/users/wpcarro/website/sandbox/learnpianochords/README.md b/users/wpcarro/website/sandbox/learnpianochords/README.md
new file mode 100644
index 000000000000..2527f4b96353
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/README.md
@@ -0,0 +1,57 @@
+# Learn Piano Chords (LPC)
+
+Are you a musician looking for a more effective way to improve your craft? Maybe
+you're a music teacher looking to create useful exercises to give your students.
+
+Studying music theory can be a fruitful undertaking, but it can often overwhelm
+or bore students. I think that if practicing is enjoyable, students will
+practice more. Practice doesn't make perfect; *perfect* practice makes perfect.
+Learn Piano Chords is a web app that lowers the barrier to practicing and
+internalizing music theory.
+
+## How does it work?
+
+1. Grab a cell phone or a laptop and your instrument.
+2. Open a web browser and visit the Learn Piano Chords app (URL and app
+   forthcoming).
+6. Set the tempo (i.e. pace) at which you would like to practice.
+4. Set the target duration of your session.
+5. Select the key(s) and chord(s) you would like to practice.
+7. LPC will display chords at various rhythmic intervals during your practice
+   session. It is your job to play these chords in time before the next chord
+   appears.
+
+## Highlights
+
+Here are some useful features of LPC:
+- Tempo: Set the rate at which LPC displays chords.
+- Predefined practice sessions: LPC offers users a few practice sessions to get
+  users started. The goal, however, is to teach users to create their own
+  bespoke practice sessions. LPC aims to foster a community of practitioners who
+  curate and share their practice sessions.
+- Whitelist / blacklist: Construct the set of chords you would like to
+  practice. Let's say you only want to practice triads in the keys of F, C, and
+  G. Would you also like to avoid diminished chords? Or maybe you *only* want to
+  practice major-7th chords for *all* keys. LPC supports all of these scenarios
+  and many others. You can save these chord configurations to reuse them at any
+  time. You can also share chord configurations with other LPC users if you find
+  the practice useful.
+- Inversions: Every chord has inversions. For instance, every triad (i.e. chord
+  composed of three notes) has three inversions: root, second, and third
+  positions. LPC acknowledges all of the positions in which chords may appear
+  and helps you study all, some, or none of these inversions.
+- Harmony: LPC understands basic harmony and can sort the chords you would like
+  to train in various harmonious permutations.
+- Chaos-mode: Feeling confident? Throw the classical notions of harmony to the
+  wayside and use LPC in "chaos-mode" where LPC samples randomly from the Circle
+  of Fifths.
+
+## Developing
+
+If you're interested in contributing, the following will create an environment
+in which you can develop:
+
+```shell
+$ nix-shell
+$ elm-live -- src/Main.elm --output=elm.js
+```
diff --git a/users/wpcarro/website/sandbox/learnpianochords/default.nix b/users/wpcarro/website/sandbox/learnpianochords/default.nix
new file mode 100644
index 000000000000..37dfd4d390f5
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/default.nix
@@ -0,0 +1,60 @@
+{ pkgs ? <nixpkgs>, ... }:
+
+with pkgs;
+
+let
+  mkDerivation =
+    { srcs ? ./elm-srcs.nix
+    , src
+    , name
+    , srcdir ? "./src"
+    , targets ? []
+    , registryDat ? ./registry.dat
+    , outputJavaScript ? false
+    }:
+    stdenv.mkDerivation {
+      inherit name src;
+
+      buildInputs = [ elmPackages.elm ]
+        ++ lib.optional outputJavaScript nodePackages_10_x.uglify-js;
+
+      buildPhase = pkgs.elmPackages.fetchElmDeps {
+        elmPackages = import srcs;
+        elmVersion = "0.19.1";
+        inherit registryDat;
+      };
+
+      installPhase = let
+        elmfile = module: "${srcdir}/${builtins.replaceStrings ["."] ["/"] module}.elm";
+        extension = if outputJavaScript then "js" else "html";
+      in ''
+        mkdir -p $out/share/doc
+        ${lib.concatStrings (map (module: ''
+          echo "compiling ${elmfile module}"
+          elm make ${elmfile module} --output $out/${module}.${extension} --docs $out/share/doc/${module}.json
+          ${lib.optionalString outputJavaScript ''
+            echo "minifying ${elmfile module}"
+            uglifyjs $out/${module}.${extension} --compress 'pure_funcs="F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9",pure_getters,keep_fargs=false,unsafe_comps,unsafe' \
+                | uglifyjs --mangle --output=$out/${module}.min.${extension}
+          ''}
+        '') targets)}
+      '';
+    };
+  mainDotElm = mkDerivation {
+    name = "elm-app-0.1.0";
+    srcs = ./elm-srcs.nix;
+    src = builtins.path { path = ./.; name = "learnpianochords"; };
+    targets = ["Main"];
+    srcdir = "./src";
+    outputJavaScript = true;
+  };
+in stdenv.mkDerivation {
+  name = "learn-piano-chords";
+  buildInputs = [];
+  src = builtins.path { path = ./.; name = "learnpianochords"; };
+  buildPhase = ''
+    mkdir -p $out
+    cp index.html output.css ${mainDotElm}/Main.min.js $out
+  '';
+  dontInstall = true;
+}
diff --git a/users/wpcarro/website/sandbox/learnpianochords/elm-srcs.nix b/users/wpcarro/website/sandbox/learnpianochords/elm-srcs.nix
new file mode 100644
index 000000000000..2823b430f887
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/elm-srcs.nix
@@ -0,0 +1,67 @@
+{
+
+      "elm-community/maybe-extra" = {
+        sha256 = "0qslmgswa625d218djd3p62pnqcrz38f5p558mbjl6kc1ss0kzv3";
+        version = "5.2.0";
+      };
+
+      "elm/html" = {
+        sha256 = "1n3gpzmpqqdsldys4ipgyl1zacn0kbpc3g4v3hdpiyfjlgh8bf3k";
+        version = "1.0.0";
+      };
+
+      "elm-community/random-extra" = {
+        sha256 = "1dg2nz77w2cvp16xazbdsxkkw0xc9ycqpkd032faqdyky6gmz9g6";
+        version = "3.1.0";
+      };
+
+      "elm/svg" = {
+        sha256 = "1cwcj73p61q45wqwgqvrvz3aypjyy3fw732xyxdyj6s256hwkn0k";
+        version = "1.0.1";
+      };
+
+      "elm/browser" = {
+        sha256 = "0nagb9ajacxbbg985r4k9h0jadqpp0gp84nm94kcgbr5sf8i9x13";
+        version = "1.0.2";
+      };
+
+      "elm/core" = {
+        sha256 = "19w0iisdd66ywjayyga4kv2p1v9rxzqjaxhckp8ni6n8i0fb2dvf";
+        version = "1.0.5";
+      };
+
+      "elm-community/list-extra" = {
+        sha256 = "1ayv3148drynqnxdfwpjxal8vwzgsjqanjg7yxp6lhdcbkxgd3vd";
+        version = "8.2.3";
+      };
+
+      "elm/random" = {
+        sha256 = "138n2455wdjwa657w6sjq18wx2r0k60ibpc4frhbqr50sncxrfdl";
+        version = "1.0.0";
+      };
+
+      "elm/time" = {
+        sha256 = "0vch7i86vn0x8b850w1p69vplll1bnbkp8s383z7pinyg94cm2z1";
+        version = "1.0.0";
+      };
+
+      "elm/json" = {
+        sha256 = "0kjwrz195z84kwywaxhhlnpl3p251qlbm5iz6byd6jky2crmyqyh";
+        version = "1.1.3";
+      };
+
+      "owanturist/elm-union-find" = {
+        sha256 = "13gm7msnp0gr1lqia5m7m4lhy3m6kvjg37d304whb3psn88wqhj5";
+        version = "1.0.0";
+      };
+
+      "elm/url" = {
+        sha256 = "0av8x5syid40sgpl5vd7pry2rq0q4pga28b4yykn9gd9v12rs3l4";
+        version = "1.0.0";
+      };
+
+      "elm/virtual-dom" = {
+        sha256 = "0q1v5gi4g336bzz1lgwpn5b1639lrn63d8y6k6pimcyismp2i1yg";
+        version = "1.0.2";
+      };
+}
diff --git a/users/wpcarro/website/sandbox/learnpianochords/elm.json b/users/wpcarro/website/sandbox/learnpianochords/elm.json
new file mode 100644
index 000000000000..a95f80408ec4
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/elm.json
@@ -0,0 +1,30 @@
+{
+    "type": "application",
+    "source-directories": [
+        "src"
+    ],
+    "elm-version": "0.19.1",
+    "dependencies": {
+        "direct": {
+            "elm/browser": "1.0.2",
+            "elm/core": "1.0.5",
+            "elm/html": "1.0.0",
+            "elm/random": "1.0.0",
+            "elm/svg": "1.0.1",
+            "elm/time": "1.0.0",
+            "elm-community/list-extra": "8.2.3",
+            "elm-community/maybe-extra": "5.2.0",
+            "elm-community/random-extra": "3.1.0"
+        },
+        "indirect": {
+            "elm/json": "1.1.3",
+            "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
+            "owanturist/elm-union-find": "1.0.0"
+        }
+    },
+    "test-dependencies": {
+        "direct": {},
+        "indirect": {}
+    }
+}
diff --git a/users/wpcarro/website/sandbox/learnpianochords/ideas.org b/users/wpcarro/website/sandbox/learnpianochords/ideas.org
new file mode 100644
index 000000000000..4c2372280ed5
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/ideas.org
@@ -0,0 +1,3 @@
+* Support a frequency table of all of the chords
+* Support using spaced-repetition to help populate the frequency table of chords
+* If doing a frequency table, support left and right hands
diff --git a/users/wpcarro/website/sandbox/learnpianochords/index.css b/users/wpcarro/website/sandbox/learnpianochords/index.css
new file mode 100644
index 000000000000..b5c61c956711
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/index.css
@@ -0,0 +1,3 @@
+@tailwind base;
+@tailwind components;
+@tailwind utilities;
diff --git a/users/wpcarro/website/sandbox/learnpianochords/index.html b/users/wpcarro/website/sandbox/learnpianochords/index.html
new file mode 100644
index 000000000000..5687c29eb7d0
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/index.html
@@ -0,0 +1,15 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="UTF-8" />
+    <title>Learn Piano Chords</title>
+    <link rel="stylesheet" href="./output.css" />
+    <script src="./Main.min.js"></script>
+  </head>
+  <body class="font-serif">
+    <div id="mount"></div>
+    <script>
+     Elm.Main.init({node: document.getElementById("mount")});
+    </script>
+  </body>
+</html>
diff --git a/users/wpcarro/website/sandbox/learnpianochords/registry.dat b/users/wpcarro/website/sandbox/learnpianochords/registry.dat
new file mode 100644
index 000000000000..a73307ccda04
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/registry.dat
Binary files differdiff --git a/users/wpcarro/website/sandbox/learnpianochords/shell.nix b/users/wpcarro/website/sandbox/learnpianochords/shell.nix
new file mode 100644
index 000000000000..00bb4b0b3edc
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/shell.nix
@@ -0,0 +1,10 @@
+let
+  briefcase = import <briefcase> {};
+  pkgs = briefcase.third_party.pkgs;
+in pkgs.mkShell {
+  buildInputs = with pkgs.elmPackages; [
+    elm
+    elm-format
+    elm-live
+  ];
+}
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/FlashCard.elm b/users/wpcarro/website/sandbox/learnpianochords/src/FlashCard.elm
new file mode 100644
index 000000000000..a4917529392a
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/FlashCard.elm
@@ -0,0 +1,42 @@
+module FlashCard exposing (render)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Responsive
+import State
+import Tailwind
+import Theory
+
+
+render :
+    { chord : Theory.Chord
+    , visible : Bool
+    }
+    -> Html State.Msg
+render { chord, visible } =
+    let
+        classes =
+            [ "bg-white"
+            , "fixed"
+            , "top-0"
+            , "left-0"
+            , "z-30"
+            , "w-screen"
+            , "h-screen"
+            , Tailwind.if_ visible "opacity-100" "opacity-0"
+            ]
+    in
+    button
+        [ classes |> Tailwind.use |> class ]
+        [ h1
+            [ [ "text-center"
+              , "transform"
+              , "-rotate-90"
+              , Responsive.h1
+              ]
+                |> Tailwind.use
+                |> class
+            ]
+            [ text (Theory.viewChord chord) ]
+        ]
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Icon.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Icon.elm
new file mode 100644
index 000000000000..2c8626b09293
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Icon.elm
@@ -0,0 +1,44 @@
+module Icon exposing (..)
+
+import Svg exposing (node, svg)
+import Svg.Attributes exposing (..)
+import UI
+
+
+svgColor color =
+    let
+        classes =
+            case color of
+                UI.Primary ->
+                    [ "text-gray-500", "fill-current" ]
+
+                UI.Secondary ->
+                    [ "text-gray-300", "fill-current" ]
+    in
+    class <| String.join " " classes
+
+
+cog =
+    svg [ class "icon-cog", viewBox "0 0 24 24", xmlLang "http://www.w3.org/2000/svg" ]
+        [ Svg.path
+            [ svgColor UI.Primary
+            , d "M6.8 3.45c.87-.52 1.82-.92 2.83-1.17a2.5 2.5 0 0 0 4.74 0c1.01.25 1.96.65 2.82 1.17a2.5 2.5 0 0 0 3.36 3.36c.52.86.92 1.8 1.17 2.82a2.5 2.5 0 0 0 0 4.74c-.25 1.01-.65 1.96-1.17 2.82a2.5 2.5 0 0 0-3.36 3.36c-.86.52-1.8.92-2.82 1.17a2.5 2.5 0 0 0-4.74 0c-1.01-.25-1.96-.65-2.82-1.17a2.5 2.5 0 0 0-3.36-3.36 9.94 9.94 0 0 1-1.17-2.82 2.5 2.5 0 0 0 0-4.74c.25-1.01.65-1.96 1.17-2.82a2.5 2.5 0 0 0 3.36-3.36zM12 16a4 4 0 1 0 0-8 4 4 0 0 0 0 8z"
+            , fill "red"
+            ]
+            []
+        , node "circle"
+            [ svgColor UI.Secondary, cx "12", cy "12", r "2" ]
+            []
+        ]
+
+
+close =
+    svg [ class "icon-close", viewBox "0 0 24 24", xmlLang "http://www.w3.org/2000/svg" ]
+        [ Svg.path
+            [ svgColor UI.Primary
+            , d "M15.78 14.36a1 1 0 0 1-1.42 1.42l-2.82-2.83-2.83 2.83a1 1 0 1 1-1.42-1.42l2.83-2.82L7.3 8.7a1 1 0 0 1 1.42-1.42l2.83 2.83 2.82-2.83a1 1 0 0 1 1.42 1.42l-2.83 2.83 2.83 2.82z"
+            , fill "red"
+            , fillRule "evenodd"
+            ]
+            []
+        ]
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Main.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Main.elm
new file mode 100644
index 000000000000..b066fb2f6f92
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Main.elm
@@ -0,0 +1,44 @@
+module Main exposing (main)
+
+import Browser
+import Html exposing (..)
+import Misc
+import Overview
+import Practice
+import Preferences
+import State
+import Time exposing (..)
+
+
+subscriptions : State.Model -> Sub State.Msg
+subscriptions model =
+    if model.isPaused then
+        Sub.none
+
+    else
+        Sub.batch
+            [ Time.every (model.tempo * 2 |> Misc.bpmToMilliseconds |> toFloat) (\_ -> State.ToggleFlashCard)
+            , Time.every (model.tempo |> Misc.bpmToMilliseconds |> toFloat) (\_ -> State.NextChord)
+            ]
+
+
+view : State.Model -> Html State.Msg
+view model =
+    case model.view of
+        State.Preferences ->
+            Preferences.render model
+
+        State.Practice ->
+            Practice.render model
+
+        State.Overview ->
+            Overview.render model
+
+
+main =
+    Browser.element
+        { init = \() -> ( State.init, Cmd.none )
+        , subscriptions = subscriptions
+        , update = State.update
+        , view = view
+        }
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Misc.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Misc.elm
new file mode 100644
index 000000000000..288d7a825f4b
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Misc.elm
@@ -0,0 +1,59 @@
+module Misc exposing (..)
+
+import Array exposing (Array)
+
+
+comesAfter : a -> List a -> Maybe a
+comesAfter x xs =
+    case xs of
+        [] ->
+            Nothing
+
+        _ :: [] ->
+            Nothing
+
+        y :: z :: rest ->
+            if y == x then
+                Just z
+
+            else
+                comesAfter x (z :: rest)
+
+
+comesBefore : a -> List a -> Maybe a
+comesBefore x xs =
+    case xs of
+        [] ->
+            Nothing
+
+        _ :: [] ->
+            Nothing
+
+        y :: z :: rest ->
+            if z == x then
+                Just y
+
+            else
+                comesBefore x (z :: rest)
+
+
+find : (a -> Bool) -> List a -> Maybe a
+find pred xs =
+    case xs |> List.filter pred of
+        [] ->
+            Nothing
+
+        x :: _ ->
+            Just x
+
+
+{-| Return the number of milliseconds that elapse during an interval in a
+`target` bpm.
+-}
+bpmToMilliseconds : Int -> Int
+bpmToMilliseconds target =
+    let
+        msPerMinute =
+            1000 * 60
+    in
+    round (toFloat msPerMinute / toFloat target)
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Overview.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Overview.elm
new file mode 100644
index 000000000000..628b52d79da9
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Overview.elm
@@ -0,0 +1,122 @@
+module Overview exposing (render)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Responsive
+import State
+import Tailwind
+import UI
+
+
+header1 : String -> Html msg
+header1 copy =
+    h2
+        [ [ "text-center"
+          , "pt-24"
+          , "pb-12"
+          , Responsive.h1
+          ]
+            |> Tailwind.use
+            |> class
+        ]
+        [ text copy ]
+
+
+header2 : String -> Html msg
+header2 copy =
+    h2
+        [ [ "text-center"
+          , "pb-10"
+          , Responsive.h2
+          ]
+            |> Tailwind.use
+            |> class
+        ]
+        [ text copy ]
+
+
+paragraph : String -> Html msg
+paragraph copy =
+    p
+        [ [ "pb-10"
+          , Responsive.h3
+          ]
+            |> Tailwind.use
+            |> class
+        ]
+        [ text copy ]
+
+
+sect : { title : String, copy : List String } -> Html msg
+sect { title, copy } =
+    section [] (header2 title :: (copy |> List.map paragraph))
+
+
+numberedList : List String -> Html msg
+numberedList items =
+    ol
+        [ [ "list-inside"
+          , "list-decimal"
+          , Responsive.h3
+          ]
+            |> Tailwind.use
+            |> class
+        ]
+        (items |> List.map (\x -> li [ [ "pb-10" ] |> Tailwind.use |> class ] [ text x ]))
+
+
+render : State.Model -> Html State.Msg
+render model =
+    div [ [ "container", "mx-auto" ] |> Tailwind.use |> class ]
+        [ header1 "Welcome to LearnPianoChords.app!"
+        , paragraph """
+                     Learn Piano Chords helps piano players master chords.
+                     """
+        , paragraph """
+                     Chords are the building blocks songwriters use to create
+                     music. Whether you're a performer or songwriter, you need
+                     to understand chords to unlock your full musical potential.
+                     """
+        , paragraph """
+                     I think that if practicing is enjoyable, students will
+                     practice more. Practice doesn’t make perfect; perfect
+                     practice makes perfect.
+                     """
+        , section []
+            [ header2 "Ready to get started?"
+            , numberedList
+                [ """
+                   Sit down at the piano.
+                   """
+                , """
+                   Set the tempo at which you would like to practice.
+                   """
+                , """
+                   Select the key or keys in which you would like to
+                   practice.
+                   """
+                , """
+                   When you are ready, close the preferences pane. We will show
+                   you the name of a chord, and you should play that chord on
+                   the piano.
+                 """
+                , """
+                   If you don't know how to play the chord, toggle the piano
+                   viewer to see the notes.
+                   """
+                , """
+                   At any point while you're training, press the screen to pause
+                   or resume your practice.
+                   """
+                ]
+            ]
+        , div [ [ "text-center", "py-20" ] |> Tailwind.use |> class ]
+            [ UI.simpleButton
+                { label = "Let's get started"
+                , handleClick = State.SetView State.Preferences
+                , color = UI.Secondary
+                , classes = []
+                }
+            ]
+        ]
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Piano.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Piano.elm
new file mode 100644
index 000000000000..d231f1467438
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Piano.elm
@@ -0,0 +1,194 @@
+module Piano exposing (render)
+
+import Browser
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import List.Extra
+import Theory
+import UI
+
+
+type alias KeyMarkup a =
+    { offset : Int
+    , isHighlit : Bool
+    , note : Theory.Note
+    , isRootNote : Bool
+    }
+    -> Html a
+
+
+type alias Props =
+    { chord : Maybe Theory.Chord
+    , firstNote : Theory.Note
+    , lastNote : Theory.Note
+    }
+
+
+naturalThickness : Int
+naturalThickness =
+    105
+
+
+accidentalThickness : Int
+accidentalThickness =
+    round (toFloat naturalThickness / 2.0)
+
+
+{-| Convert an integer into its pixel representation for CSS.
+-}
+pixelate : Int -> String
+pixelate x =
+    String.fromInt x ++ "px"
+
+
+{-| Return the markup for either a white or a black key.
+-}
+pianoKey : KeyMarkup a
+pianoKey { offset, isHighlit, note, isRootNote } =
+    let
+        { natColor, accColor, hiColor, rootColor } =
+            { natColor = "bg-white"
+            , accColor = "bg-black"
+            , hiColor = "bg-red-400"
+            , rootColor = "bg-red-600"
+            }
+
+        sharedClasses =
+            [ "box-border"
+            , "absolute"
+            , "border"
+            , "border-black"
+            ]
+
+        { keyLength, keyThickness, keyColor, offsetEdge, extraClasses } =
+            case Theory.keyClass note of
+                Theory.Natural ->
+                    { keyLength = "w-screen"
+                    , keyThickness = naturalThickness
+                    , keyColor = natColor
+                    , offsetEdge = "top"
+                    , extraClasses = []
+                    }
+
+                Theory.Accidental ->
+                    { keyLength = "w-2/3"
+                    , keyThickness = accidentalThickness
+                    , keyColor = accColor
+                    , offsetEdge = "top"
+                    , extraClasses = [ "z-10" ]
+                    }
+    in
+    div
+        [ class
+            (case ( isHighlit, isRootNote ) of
+                ( False, _ ) ->
+                    keyColor
+
+                ( True, True ) ->
+                    rootColor
+
+                ( True, False ) ->
+                    hiColor
+            )
+        , class keyLength
+        , style "height" (pixelate keyThickness)
+        , style offsetEdge (String.fromInt offset ++ "px")
+        , class <| String.join " " (List.concat [ sharedClasses, extraClasses ])
+        ]
+        []
+
+
+{-| A section of the piano consisting of all twelve notes.
+-}
+keys :
+    { start : Theory.Note
+    , end : Theory.Note
+    , highlitNotes : List Theory.Note
+    , rootNote : Maybe Theory.Note
+    }
+    -> List (Html a)
+keys { start, end, highlitNotes, rootNote } =
+    let
+        isHighlit note =
+            List.member note highlitNotes
+
+        spacing prevOffset prev curr =
+            case ( Theory.keyClass prev, Theory.keyClass curr ) of
+                ( Theory.Natural, Theory.Accidental ) ->
+                    prevOffset + naturalThickness - round (toFloat accidentalThickness / 2)
+
+                ( Theory.Accidental, Theory.Natural ) ->
+                    prevOffset + round (toFloat accidentalThickness / 2)
+
+                ( Theory.Natural, Theory.Natural ) ->
+                    prevOffset + naturalThickness
+
+                -- This pattern should never hit.
+                _ ->
+                    prevOffset
+
+        ( _, _, notes ) =
+            Theory.notesFromRange start end
+                |> List.reverse
+                |> List.foldl
+                    (\curr ( prevOffset, prev, result ) ->
+                        case ( prevOffset, prev ) of
+                            ( Nothing, Nothing ) ->
+                                ( Just 0
+                                , Just curr
+                                , pianoKey
+                                    { offset = 0
+                                    , isHighlit = List.member curr highlitNotes
+                                    , note = curr
+                                    , isRootNote =
+                                        rootNote
+                                            |> Maybe.map (\x -> x == curr)
+                                            |> Maybe.withDefault False
+                                    }
+                                    :: result
+                                )
+
+                            ( Just po, Just p ) ->
+                                let
+                                    offset =
+                                        spacing po p curr
+                                in
+                                ( Just offset
+                                , Just curr
+                                , pianoKey
+                                    { offset = offset
+                                    , isHighlit = List.member curr highlitNotes
+                                    , note = curr
+                                    , isRootNote =
+                                        rootNote
+                                            |> Maybe.map (\x -> x == curr)
+                                            |> Maybe.withDefault False
+                                    }
+                                    :: result
+                                )
+
+                            -- This pattern should never hit.
+                            _ ->
+                                ( Nothing, Nothing, [] )
+                    )
+                    ( Nothing, Nothing, [] )
+    in
+    notes
+
+
+{-| Return the HTML that renders a piano representation.
+-}
+render : Props -> Html a
+render { chord } =
+    div [ style "display" "flex" ]
+        (keys
+            { start = Theory.G3
+            , end = Theory.C6
+            , rootNote = chord |> Maybe.map .note
+            , highlitNotes =
+                chord
+                    |> Maybe.andThen Theory.notesForChord
+                    |> Maybe.withDefault []
+            }
+        )
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Practice.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Practice.elm
new file mode 100644
index 000000000000..5d87bcee501e
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Practice.elm
@@ -0,0 +1,61 @@
+module Practice exposing (render)
+
+import FlashCard
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Icon
+import Piano
+import State
+import Tailwind
+import Theory
+import UI
+
+
+openPreferences : Html State.Msg
+openPreferences =
+    button
+        [ class "w-48 h-48 absolute left-0 top-0 z-50"
+        , onClick (State.SetView State.Preferences)
+        ]
+        [ Icon.cog ]
+
+
+render : State.Model -> Html State.Msg
+render model =
+    let
+        ( handleClick, buttonText ) =
+            if model.isPaused then
+                ( State.Play, "Tap to practice" )
+
+            else
+                ( State.Pause, "" )
+    in
+    div []
+        [ openPreferences
+        , case model.selectedChord of
+            Just chord ->
+                FlashCard.render
+                    { chord = chord
+                    , visible = model.showFlashCard
+                    }
+
+            Nothing ->
+                -- Here I'm abusing the overlayButton component to render text
+                -- horizontally. I should support a UI component for this.
+                UI.overlayButton
+                    { label = "Get ready..."
+                    , handleClick = State.DoNothing
+                    , isVisible = True
+                    }
+        , UI.overlayButton
+            { label = buttonText
+            , handleClick = handleClick
+            , isVisible = model.isPaused
+            }
+        , Piano.render
+            { chord = model.selectedChord
+            , firstNote = model.firstNote
+            , lastNote = model.lastNote
+            }
+        ]
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Preferences.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Preferences.elm
new file mode 100644
index 000000000000..59e6c8234c13
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Preferences.elm
@@ -0,0 +1,148 @@
+module Preferences exposing (render)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Icon
+import Responsive
+import State
+import Tailwind
+import Tempo
+import Theory
+import UI
+
+
+selectKey :
+    State.Model
+    ->
+        { relativeMajor : Theory.Key
+        , relativeMinor : Theory.Key
+        }
+    -> Html State.Msg
+selectKey model { relativeMajor, relativeMinor } =
+    let
+        active key =
+            List.member key model.whitelistedKeys
+
+        buttonLabel major minor =
+            Theory.viewKey major ++ ", " ++ Theory.viewKey minor
+    in
+    div [ class "flex pt-0" ]
+        [ UI.textToggleButton
+            { label = buttonLabel relativeMajor relativeMinor
+            , handleClick = State.ToggleKey relativeMajor
+            , classes = [ "flex-1" ]
+            , toggled = active relativeMajor
+            }
+        ]
+
+
+inversionCheckboxes : State.Model -> Html State.Msg
+inversionCheckboxes model =
+    div []
+        [ h2
+            [ [ "text-gray-500"
+              , "text-center"
+              , "pt-10"
+              , Responsive.h2
+              ]
+                |> Tailwind.use
+                |> class
+            ]
+            [ text "Select inversions" ]
+        , ul
+            [ [ "flex", "justify-center" ] |> Tailwind.use |> class ]
+            (Theory.allInversions
+                |> List.map
+                    (\inversion ->
+                        li []
+                            [ UI.textToggleButton
+                                { label = Theory.inversionName inversion
+                                , handleClick = State.ToggleInversion inversion
+                                , classes = []
+                                , toggled = List.member inversion model.whitelistedInversions
+                                }
+                            ]
+                    )
+            )
+        ]
+
+
+keyCheckboxes : State.Model -> Html State.Msg
+keyCheckboxes model =
+    let
+        majorKey pitchClass =
+            { pitchClass = pitchClass, mode = Theory.MajorMode }
+
+        minorKey pitchClass =
+            { pitchClass = pitchClass, mode = Theory.MinorMode }
+
+        circleOfFifths =
+            [ ( Theory.C, Theory.A )
+            , ( Theory.G, Theory.E )
+            , ( Theory.D, Theory.B )
+            , ( Theory.A, Theory.F_sharp )
+            , ( Theory.E, Theory.C_sharp )
+            , ( Theory.B, Theory.G_sharp )
+            , ( Theory.F_sharp, Theory.D_sharp )
+            , ( Theory.C_sharp, Theory.A_sharp )
+            , ( Theory.G_sharp, Theory.F )
+            , ( Theory.D_sharp, Theory.C )
+            , ( Theory.A_sharp, Theory.G )
+            , ( Theory.F, Theory.D )
+            ]
+    in
+    div []
+        [ h2
+            [ [ "text-gray-500"
+              , "text-center"
+              , "pt-10"
+              , Responsive.h2
+              ]
+                |> Tailwind.use
+                |> class
+            ]
+            [ text "Select keys" ]
+        , ul []
+            (circleOfFifths
+                |> List.map
+                    (\( major, minor ) ->
+                        selectKey model
+                            { relativeMajor = majorKey major
+                            , relativeMinor = minorKey minor
+                            }
+                    )
+            )
+        ]
+
+
+closePreferences : Html State.Msg
+closePreferences =
+    button
+        [ [ "w-48"
+          , "lg:w-32"
+          , "h-48"
+          , "lg:h-32"
+          , "absolute"
+          , "right-0"
+          , "top-0"
+          , "z-10"
+          ]
+            |> Tailwind.use
+            |> class
+        , onClick (State.SetView State.Practice)
+        ]
+        [ Icon.close ]
+
+
+render : State.Model -> Html State.Msg
+render model =
+    div [ class "pt-10 pb-20 px-10" ]
+        [ closePreferences
+        , Tempo.render
+            { tempo = model.tempo
+            , handleInput = State.SetTempo
+            }
+        , inversionCheckboxes model
+        , keyCheckboxes model
+        ]
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Responsive.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Responsive.elm
new file mode 100644
index 000000000000..5d97161df6a8
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Responsive.elm
@@ -0,0 +1,19 @@
+module Responsive exposing (..)
+
+{-| Returns a string containing all of the Tailwind selectors we use to size
+h2-sized elements across various devices. -}
+h1 : String
+h1 =
+    "text-6xl lg:text-4xl"
+
+{-| Returns a string containing all of the Tailwind selectors we use to size
+h2-sized elements across various devices. -}
+h2 : String
+h2 =
+    "text-5xl lg:text-3xl"
+
+{-| Returns a string containing all of the Tailwind selectors we use to size
+h3-sized elements across various devices. -}
+h3 : String
+h3 =
+    "text-4xl lg:text-2xl"
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/State.elm b/users/wpcarro/website/sandbox/learnpianochords/src/State.elm
new file mode 100644
index 000000000000..678fb0f9aa79
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/State.elm
@@ -0,0 +1,179 @@
+module State exposing (..)
+
+import Random
+import Random.List
+import Theory
+
+
+type Msg
+    = NextChord
+    | NewChord Theory.Chord
+    | Play
+    | Pause
+    | SetTempo String
+    | ToggleInversion Theory.ChordInversion
+    | ToggleKey Theory.Key
+    | DoNothing
+    | SetView View
+    | ToggleFlashCard
+
+
+type View
+    = Preferences
+    | Practice
+    | Overview
+
+
+type alias Model =
+    { whitelistedChords : List Theory.Chord
+    , whitelistedChordTypes : List Theory.ChordType
+    , whitelistedInversions : List Theory.ChordInversion
+    , whitelistedPitchClasses : List Theory.PitchClass
+    , whitelistedKeys : List Theory.Key
+    , selectedChord : Maybe Theory.Chord
+    , isPaused : Bool
+    , tempo : Int
+    , firstNote : Theory.Note
+    , lastNote : Theory.Note
+    , view : View
+    , showFlashCard : Bool
+    }
+
+
+{-| The initial state for the application.
+-}
+init : Model
+init =
+    let
+        ( firstNote, lastNote ) =
+            ( Theory.C3, Theory.C6 )
+
+        inversions =
+            [ Theory.Root ]
+
+        chordTypes =
+            Theory.allChordTypes
+
+        pitchClasses =
+            Theory.allPitchClasses
+
+        keys =
+            [ { pitchClass = Theory.C, mode = Theory.MajorMode } ]
+    in
+    { whitelistedChords =
+        keys
+            |> List.concatMap Theory.chordsForKey
+            |> List.filter (\chord -> List.member chord.chordInversion inversions)
+    , whitelistedChordTypes = chordTypes
+    , whitelistedInversions = inversions
+    , whitelistedPitchClasses = pitchClasses
+    , whitelistedKeys = keys
+    , selectedChord = Nothing
+    , isPaused = True
+    , tempo = 10
+    , firstNote = firstNote
+    , lastNote = lastNote
+    , view = Overview
+    , showFlashCard = True
+    }
+
+
+{-| Now that we have state, we need a function to change the state.
+-}
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        DoNothing ->
+            ( model, Cmd.none )
+
+        SetView x ->
+            ( { model
+                | view = x
+                , isPaused = True
+              }
+            , Cmd.none
+            )
+
+        NewChord chord ->
+            ( { model | selectedChord = Just chord }
+            , Cmd.none
+            )
+
+        NextChord ->
+            ( model
+            , Random.generate
+                (\x ->
+                    case x of
+                        ( Just chord, _ ) ->
+                            NewChord chord
+
+                        ( Nothing, _ ) ->
+                            DoNothing
+                )
+                (Random.List.choose model.whitelistedChords)
+            )
+
+        Play ->
+            ( { model | isPaused = False }
+            , Cmd.none
+            )
+
+        Pause ->
+            ( { model | isPaused = True }
+            , Cmd.none
+            )
+
+        ToggleInversion inversion ->
+            let
+                inversions =
+                    if List.member inversion model.whitelistedInversions then
+                        List.filter ((/=) inversion) model.whitelistedInversions
+
+                    else
+                        inversion :: model.whitelistedInversions
+            in
+            ( { model
+                | whitelistedInversions = inversions
+                , whitelistedChords =
+                    model.whitelistedKeys
+                        |> List.concatMap Theory.chordsForKey
+                        |> List.filter (\chord -> List.member chord.chordInversion inversions)
+              }
+            , Cmd.none
+            )
+
+        ToggleKey key ->
+            let
+                keys =
+                    if List.member key model.whitelistedKeys then
+                        List.filter ((/=) key) model.whitelistedKeys
+
+                    else
+                        key :: model.whitelistedKeys
+            in
+            ( { model
+                | whitelistedKeys = keys
+                , whitelistedChords =
+                    keys
+                        |> List.concatMap Theory.chordsForKey
+                        |> List.filter (\chord -> List.member chord.chordInversion model.whitelistedInversions)
+                , selectedChord = Nothing
+              }
+            , Cmd.none
+            )
+
+        SetTempo tempo ->
+            ( { model
+                | tempo =
+                    case String.toInt tempo of
+                        Just x ->
+                            x
+
+                        Nothing ->
+                            model.tempo
+              }
+            , Cmd.none
+            )
+
+        ToggleFlashCard ->
+            ( { model | showFlashCard = not model.showFlashCard }, Cmd.none )
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Tailwind.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Tailwind.elm
new file mode 100644
index 000000000000..57d419db5a82
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Tailwind.elm
@@ -0,0 +1,29 @@
+module Tailwind exposing (..)
+
+{-| Functions to make Tailwind development in Elm even more pleasant.
+-}
+
+
+{-| Conditionally use `class` selection when `condition` is true.
+-}
+when : Bool -> String -> String
+when condition class =
+    if condition then
+        class
+
+    else
+        ""
+
+
+if_ : Bool -> String -> String -> String
+if_ condition whenTrue whenFalse =
+    if condition then
+        whenTrue
+
+    else
+        whenFalse
+
+
+use : List String -> String
+use styles =
+    String.join " " styles
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Tempo.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Tempo.elm
new file mode 100644
index 000000000000..041313614f53
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Tempo.elm
@@ -0,0 +1,33 @@
+module Tempo exposing (render)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Responsive
+import Tailwind
+import UI
+
+
+type alias Props msg =
+    { tempo : Int
+    , handleInput : String -> msg
+    }
+
+
+render : Props msg -> Html msg
+render { tempo, handleInput } =
+    div [ class "text-center" ]
+        [ p
+            [ [ "py-10"
+              , Responsive.h2
+              ]
+                |> Tailwind.use
+                |> class
+            ]
+            [ text (String.fromInt tempo ++ " BPM") ]
+        , UI.textField
+            { placeholderText = "Set tempo..."
+            , handleInput = handleInput
+            , classes = []
+            }
+        ]
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/Theory.elm b/users/wpcarro/website/sandbox/learnpianochords/src/Theory.elm
new file mode 100644
index 000000000000..7f54832c97a0
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/Theory.elm
@@ -0,0 +1,1100 @@
+module Theory exposing (..)
+
+import Array exposing (Array)
+import Dict exposing (Dict)
+import List.Extra
+import Maybe.Extra
+import Misc
+
+
+{-| Notes are the individuals sounds that we use to create music. Think: "do re
+mi fa so la ti do".
+
+Note: Technically a "C-sharp" is also a "D-flat", but I will model accidentals
+(i.e. sharps and flats) as sharps and represent the ambiguity when I render the
+underlying state of the application.
+
+Note: There are "notes" like A, B, D-flat, and then there are notes like "middle
+C", also denoted in scientific pitch notation as C4. I'm unsure of what to call
+each of these, and my application does not model scientific pitch notation yet,
+so these non-scientific pitch denote values are "notes" for now.
+
+-}
+type Note
+    = C1
+    | C_sharp1
+    | D1
+    | D_sharp1
+    | E1
+    | F1
+    | F_sharp1
+    | G1
+    | G_sharp1
+    | A1
+    | A_sharp1
+    | B1
+    | C2
+    | C_sharp2
+    | D2
+    | D_sharp2
+    | E2
+    | F2
+    | F_sharp2
+    | G2
+    | G_sharp2
+    | A2
+    | A_sharp2
+    | B2
+    | C3
+    | C_sharp3
+    | D3
+    | D_sharp3
+    | E3
+    | F3
+    | F_sharp3
+    | G3
+    | G_sharp3
+    | A3
+    | A_sharp3
+    | B3
+    | C4
+    | C_sharp4
+    | D4
+    | D_sharp4
+    | E4
+    | F4
+    | F_sharp4
+    | G4
+    | G_sharp4
+    | A4
+    | A_sharp4
+    | B4
+    | C5
+    | C_sharp5
+    | D5
+    | D_sharp5
+    | E5
+    | F5
+    | F_sharp5
+    | G5
+    | G_sharp5
+    | A5
+    | A_sharp5
+    | B5
+    | C6
+    | C_sharp6
+    | D6
+    | D_sharp6
+    | E6
+    | F6
+    | F_sharp6
+    | G6
+    | G_sharp6
+    | A6
+    | A_sharp6
+    | B6
+    | C7
+    | C_sharp7
+    | D7
+    | D_sharp7
+    | E7
+    | F7
+    | F_sharp7
+    | G7
+    | G_sharp7
+    | A7
+    | A_sharp7
+    | B7
+    | C8
+
+
+{-| I alluded to this concept in the Note type's documentation. These are the
+letters of notes. For instance C2, C3, C4 are all instances of C.
+-}
+type PitchClass
+    = C
+    | C_sharp
+    | D
+    | D_sharp
+    | E
+    | F
+    | F_sharp
+    | G
+    | G_sharp
+    | A
+    | A_sharp
+    | B
+
+
+{-| Encode whether you are traversing "up" or "down" intervals
+-}
+type StepDirection
+    = Up
+    | Down
+
+
+{-| One can measure the difference between between notes using intervals.
+-}
+type Interval
+    = Half
+    | NHalves Int
+    | Whole
+    | MajorThird
+    | MinorThird
+    | PerfectFifth
+    | AugmentedFifth
+    | DiminishedFifth
+    | MajorSeventh
+    | DominantSeventh
+
+
+{-| Add direction to a distance on the piano.
+-}
+type alias IntervalVector =
+    { interval : Interval
+    , direction : StepDirection
+    }
+
+
+{-| A bundle of notes which are usually, but not necessarily harmonious.
+-}
+type alias Chord =
+    { note : Note
+    , chordType : ChordType
+    , chordInversion : ChordInversion
+    }
+
+
+{-| Many possible chords exist. This type encodes the possibilities. I am
+tempted to model these in a more "DRY" way, but I worry that this abstraction
+may cause more problems than it solves.
+-}
+type ChordType
+    = Major
+    | Sus2
+    | Sus4
+    | Major7
+    | MajorDominant7
+    | Minor
+    | MinorMajor7
+    | MinorDominant7
+    | Augmented
+    | AugmentedDominant7
+    | Diminished
+    | DiminishedDominant7
+    | DiminishedMajor7
+
+
+{-| On a piano, a triad can be played three ways. As a rule-of-thumb, The number
+of ways a pianist can play a chord is equal to the number of notes in the chord
+itself.
+-}
+type ChordInversion
+    = Root
+    | First
+    | Second
+
+
+{-| Whether a given note is a white key or a black key.
+-}
+type KeyClass
+    = Natural
+    | Accidental
+
+
+{-| Songs are written in one or more keys, which define the notes and therefore
+chords that harmonize with one another.
+-}
+type alias Key =
+    { pitchClass : PitchClass
+    , mode : Mode
+    }
+
+
+{-| We create "scales" by enumerating the notes of a given key. These keys are
+defined by the "tonic" note and the "mode". I thought about including Ionian,
+Dorian, Phrygian, etc., but in the I would like to avoid over-abstracting this
+early on, so I'm going to err on the side of overly concrete until I have a
+better idea of the extent of this project.
+-}
+type Mode
+    = BluesMode
+    | MajorMode
+    | MinorMode
+
+
+type alias NoteMetadata =
+    { note : Note
+    , label : String
+    , pitchClass : PitchClass
+    , natural : Bool
+    }
+
+
+{-| An integer representing which note in a given scale to play.
+-}
+type alias ScaleDegree =
+    Int
+
+
+{-| Returns the Note in the cental octave of the piano for a given
+PitchClass. For example, C4 -- or "middle C" -- for C.
+-}
+noteInCentralOctave : PitchClass -> Note
+noteInCentralOctave pitchClass =
+    case pitchClass of
+        C ->
+            C4
+
+        C_sharp ->
+            C_sharp4
+
+        D ->
+            D4
+
+        D_sharp ->
+            D_sharp4
+
+        E ->
+            E4
+
+        F ->
+            F4
+
+        F_sharp ->
+            F_sharp4
+
+        G ->
+            G4
+
+        G_sharp ->
+            G_sharp4
+
+        A ->
+            A4
+
+        A_sharp ->
+            A_sharp4
+
+        B ->
+            B4
+
+
+{-| Return the human-readable version of a chord inversion.
+-}
+inversionName : ChordInversion -> String
+inversionName inversion =
+    case inversion of
+        Root ->
+            "Root"
+
+        First ->
+            "First"
+
+        Second ->
+            "Second"
+
+
+{-| Return the human-readable version of a chord type.
+-}
+chordTypeName : ChordType -> String
+chordTypeName chordType =
+    case chordType of
+        Major ->
+            "major"
+
+        Sus2 ->
+            "suspended 2"
+
+        Sus4 ->
+            "suspended 4"
+
+        Major7 ->
+            "major 7th"
+
+        MajorDominant7 ->
+            "major dominant 7th"
+
+        Minor ->
+            "minor"
+
+        MinorMajor7 ->
+            "minor major 7th"
+
+        MinorDominant7 ->
+            "minor dominant 7th"
+
+        Augmented ->
+            "augmented"
+
+        AugmentedDominant7 ->
+            "augmented dominant 7th"
+
+        Diminished ->
+            "diminished"
+
+        DiminishedDominant7 ->
+            "diminished dominant 7th"
+
+        DiminishedMajor7 ->
+            "diminished major 7th"
+
+
+{-| Return the note that is one half step away from `note` in the direction,
+`dir`.
+In the case of stepping up or down from the end of the piano, this returns a
+Maybe.
+-}
+halfStep : StepDirection -> Note -> Maybe Note
+halfStep dir note =
+    let
+        everyNote =
+            notesFromRange C2 C8
+    in
+    case dir of
+        Up ->
+            Misc.comesAfter note everyNote
+
+        Down ->
+            Misc.comesBefore note everyNote
+
+
+{-| Return a list of steps to take away from the root note to return back to the
+root note for a given mode.
+-}
+intervalsForMode : Mode -> List IntervalVector
+intervalsForMode mode =
+    let
+        up x =
+            { direction = Up, interval = x }
+
+        down x =
+            { direction = Down, interval = x }
+    in
+    case mode of
+        MajorMode ->
+            List.map up [ Whole, Whole, Half, Whole, Whole, Whole ]
+
+        MinorMode ->
+            List.map up [ Whole, Half, Whole, Whole, Half, Whole ]
+
+        BluesMode ->
+            List.map up [ MinorThird, Whole, Half, Half, MinorThird ]
+
+
+{-| Return a list of the intervals that a chord. Each interval measures
+the distance away from the root-note of the chord.
+-}
+intervalsForChordType : ChordType -> ChordInversion -> List IntervalVector
+intervalsForChordType chordType chordInversion =
+    let
+        up x =
+            { direction = Up, interval = x }
+
+        down x =
+            { direction = Down, interval = x }
+    in
+    case ( chordType, chordInversion ) of
+        -- Major
+        ( Major, Root ) ->
+            [ up MajorThird, up PerfectFifth ]
+
+        ( Major, First ) ->
+            [ down (NHalves 5), down (NHalves 8) ]
+
+        ( Major, Second ) ->
+            [ down (NHalves 5), up MajorThird ]
+
+        -- Sus2
+        ( Sus2, Root ) ->
+            [ up Whole, up PerfectFifth ]
+
+        ( Sus2, First ) ->
+            [ down (NHalves 10), down (NHalves 5) ]
+
+        ( Sus2, Second ) ->
+            [ down (NHalves 5), up Whole ]
+
+        -- Sus4
+        ( Sus4, Root ) ->
+            [ up (NHalves 5), up PerfectFifth ]
+
+        ( Sus4, First ) ->
+            [ down (NHalves 7), down (NHalves 5) ]
+
+        ( Sus4, Second ) ->
+            [ down (NHalves 5), up (NHalves 5) ]
+
+        -- Major7
+        ( Major7, Root ) ->
+            [ up MajorThird, up PerfectFifth, up MajorSeventh ]
+
+        ( Major7, First ) ->
+            down Half :: intervalsForChordType Major chordInversion
+
+        ( Major7, Second ) ->
+            down Half :: intervalsForChordType Major chordInversion
+
+        -- MajorDominant7
+        ( MajorDominant7, Root ) ->
+            up DominantSeventh :: intervalsForChordType Major chordInversion
+
+        ( MajorDominant7, First ) ->
+            down Whole :: intervalsForChordType Major chordInversion
+
+        ( MajorDominant7, Second ) ->
+            down Whole :: intervalsForChordType Major chordInversion
+
+        -- Minor
+        ( Minor, Root ) ->
+            [ up MinorThird, up PerfectFifth ]
+
+        ( Minor, First ) ->
+            [ down (NHalves 5), down (NHalves 9) ]
+
+        ( Minor, Second ) ->
+            [ down (NHalves 5), up MinorThird ]
+
+        -- MinorMajor7
+        ( MinorMajor7, Root ) ->
+            up MajorSeventh :: intervalsForChordType Minor chordInversion
+
+        ( MinorMajor7, First ) ->
+            down Half :: intervalsForChordType Minor chordInversion
+
+        ( MinorMajor7, Second ) ->
+            down Half :: intervalsForChordType Minor chordInversion
+
+        -- MinorDominant7
+        ( MinorDominant7, Root ) ->
+            up DominantSeventh :: intervalsForChordType Minor chordInversion
+
+        ( MinorDominant7, First ) ->
+            down Whole :: intervalsForChordType Minor chordInversion
+
+        ( MinorDominant7, Second ) ->
+            down Whole :: intervalsForChordType Minor chordInversion
+
+        -- Augmented
+        ( Augmented, Root ) ->
+            [ up MajorThird, up AugmentedFifth ]
+
+        ( Augmented, First ) ->
+            [ down (NHalves 8), down (NHalves 4) ]
+
+        ( Augmented, Second ) ->
+            [ down (NHalves 4), up MajorThird ]
+
+        -- AugmentedDominant7
+        ( AugmentedDominant7, Root ) ->
+            up DominantSeventh :: intervalsForChordType Augmented chordInversion
+
+        ( AugmentedDominant7, First ) ->
+            down Whole :: intervalsForChordType Augmented chordInversion
+
+        ( AugmentedDominant7, Second ) ->
+            down Whole :: intervalsForChordType Augmented chordInversion
+
+        -- Diminished
+        ( Diminished, Root ) ->
+            [ up MinorThird, up DiminishedFifth ]
+
+        ( Diminished, First ) ->
+            [ down (NHalves 6), down (NHalves 9) ]
+
+        ( Diminished, Second ) ->
+            [ down (NHalves 6), up MinorThird ]
+
+        -- DiminishedDominant7
+        ( DiminishedDominant7, Root ) ->
+            up DominantSeventh :: intervalsForChordType Diminished chordInversion
+
+        ( DiminishedDominant7, First ) ->
+            down Whole :: intervalsForChordType Diminished chordInversion
+
+        ( DiminishedDominant7, Second ) ->
+            down Whole :: intervalsForChordType Diminished chordInversion
+
+        -- DiminishedMajor7
+        ( DiminishedMajor7, Root ) ->
+            up MajorSeventh :: intervalsForChordType Diminished chordInversion
+
+        ( DiminishedMajor7, First ) ->
+            down Half :: intervalsForChordType Diminished chordInversion
+
+        ( DiminishedMajor7, Second ) ->
+            down Half :: intervalsForChordType Diminished chordInversion
+
+
+{-| Return the note in the direction, `dir`, away from `note` `s` intervals
+-}
+step : IntervalVector -> Note -> Maybe Note
+step { direction, interval } note =
+    let
+        doStep int =
+            step { direction = direction, interval = int }
+    in
+    case interval of
+        Half ->
+            halfStep direction note
+
+        NHalves n ->
+            List.repeat n
+                { direction = direction
+                , interval = Half
+                }
+                |> (\x -> walkNotes x note)
+                |> Maybe.andThen (List.reverse >> List.head)
+
+        Whole ->
+            note
+                |> doStep Half
+                |> Maybe.andThen (doStep Half)
+
+        MinorThird ->
+            note
+                |> doStep Whole
+                |> Maybe.andThen (doStep Half)
+
+        MajorThird ->
+            note
+                |> doStep Whole
+                |> Maybe.andThen (doStep Whole)
+
+        PerfectFifth ->
+            note
+                |> doStep MajorThird
+                |> Maybe.andThen (doStep MinorThird)
+
+        AugmentedFifth ->
+            note
+                |> doStep PerfectFifth
+                |> Maybe.andThen (doStep Half)
+
+        DiminishedFifth ->
+            note
+                |> doStep MajorThird
+                |> Maybe.andThen (doStep Whole)
+
+        MajorSeventh ->
+            note
+                |> doStep PerfectFifth
+                |> Maybe.andThen (doStep MajorThird)
+
+        DominantSeventh ->
+            note
+                |> doStep PerfectFifth
+                |> Maybe.andThen (doStep MinorThird)
+
+
+{-| Returns a list of all of the notes away from a give `note`.
+
+  - The 0th element is applied to `note`.
+  - The 1st element is applied to the result of the previous operation.
+  - The 2nd element is applied to the result of the previous operation.
+  - and so on...until all of the `steps` are exhausted.
+
+In the case where applying any of the steps would result in running off of
+either edge of the piano, this function returns a Nothing.
+
+-}
+walkNotes : List IntervalVector -> Note -> Maybe (List Note)
+walkNotes steps note =
+    doWalkNotes steps note [] |> Maybe.map List.reverse
+
+
+{-| Recursive helper for `walkNotes`.
+-}
+doWalkNotes : List IntervalVector -> Note -> List Note -> Maybe (List Note)
+doWalkNotes steps note result =
+    case steps of
+        [] ->
+            Just (note :: result)
+
+        s :: rest ->
+            case step s note of
+                Just x ->
+                    doWalkNotes rest x (note :: result)
+
+                Nothing ->
+                    Nothing
+
+
+{-| Return the KeyClass for a given `note`.
+-}
+keyClass : Note -> KeyClass
+keyClass note =
+    if isNatural note then
+        Natural
+
+    else
+        Accidental
+
+
+{-| Return the PitchClass for a given note.
+-}
+classifyNote : Note -> PitchClass
+classifyNote note =
+    note |> getNoteMetadata |> .pitchClass
+
+
+{-| Return a list of the notes that comprise a `chord`
+-}
+notesForChord : Chord -> Maybe (List Note)
+notesForChord { note, chordType, chordInversion } =
+    intervalsForChordType chordType chordInversion
+        |> List.map (\interval -> step interval note)
+        |> Maybe.Extra.combine
+        |> Maybe.map (\notes -> note :: notes)
+
+
+{-| Return the scale for a given `key`.
+-}
+notesForKey : Key -> List Note
+notesForKey { pitchClass, mode } =
+    let
+        origin =
+            noteInCentralOctave pitchClass
+    in
+    case walkNotes (intervalsForMode mode) origin of
+        -- We should never hit the Nothing case here.
+        Nothing ->
+            []
+
+        Just scale ->
+            scale
+
+
+{-| Return true if `note` is a black key.
+-}
+isAccidental : Note -> Bool
+isAccidental note =
+    note |> isNatural |> not
+
+
+{-| Return true if `note` is a white key.
+-}
+isNatural : Note -> Bool
+isNatural note =
+    note |> getNoteMetadata |> .natural
+
+
+{-| Return a list of all of the notes that we know about.
+Only return the notes within the range `start` and `end`.
+-}
+notesFromRange : Note -> Note -> List Note
+notesFromRange start end =
+    noteMetadata
+        |> Array.toList
+        |> List.map .note
+        |> List.Extra.dropWhile ((/=) start)
+        |> List.Extra.takeWhile ((/=) end)
+
+
+{-| Return a list of all of the chord inversions about which we know.
+-}
+allInversions : List ChordInversion
+allInversions =
+    [ Root, First, Second ]
+
+
+{-| Return a list of all of the chord types about which we know.
+-}
+allChordTypes : List ChordType
+allChordTypes =
+    [ Major
+    , Sus2
+    , Sus4
+    , Major7
+    , MajorDominant7
+    , Minor
+    , MinorMajor7
+    , MinorDominant7
+    , Augmented
+    , AugmentedDominant7
+    , Diminished
+    , DiminishedDominant7
+    , DiminishedMajor7
+    ]
+
+
+{-| Return a list of all of the key modes about which we know.
+-}
+allModes : List Mode
+allModes =
+    [ MajorMode, MinorMode, BluesMode ]
+
+
+{-| Return a list of all of the keys about which we know.
+-}
+allKeys : List Key
+allKeys =
+    allPitchClasses
+        |> List.Extra.andThen
+            (\pitchClass ->
+                allModes
+                    |> List.Extra.andThen
+                        (\mode ->
+                            [ { pitchClass = pitchClass
+                              , mode = mode
+                              }
+                            ]
+                        )
+            )
+
+
+{-| Return an array of every note on a piano.
+Note: Currently this piano has 85 keys, but modern pianos have 88 keys. I would
+prefer to have 88 keys, but it's not urgent.
+-}
+noteMetadata : Array NoteMetadata
+noteMetadata =
+    Array.fromList
+        [ { note = A1, label = "A1", pitchClass = A, natural = True }
+        , { note = A_sharp1, label = "A♯/B♭1", pitchClass = A_sharp, natural = False }
+        , { note = B1, label = "B1", pitchClass = B, natural = True }
+        , { note = C1, label = "C1", pitchClass = C, natural = True }
+        , { note = C_sharp1, label = "C♯/D♭1", pitchClass = C_sharp, natural = False }
+        , { note = D1, label = "D1", pitchClass = D, natural = True }
+        , { note = D_sharp1, label = "D♯/E♭1", pitchClass = D_sharp, natural = False }
+        , { note = E1, label = "E1", pitchClass = E, natural = True }
+        , { note = F1, label = "F1", pitchClass = F, natural = True }
+        , { note = F_sharp1, label = "F♯/G♭1", pitchClass = F_sharp, natural = False }
+        , { note = G1, label = "G1", pitchClass = G, natural = True }
+        , { note = G_sharp1, label = "G♯/A♭1", pitchClass = G_sharp, natural = False }
+        , { note = A2, label = "A2", pitchClass = A, natural = True }
+        , { note = A_sharp2, label = "A♯/B♭2", pitchClass = A_sharp, natural = False }
+        , { note = B2, label = "B2", pitchClass = B, natural = True }
+        , { note = C2, label = "C2", pitchClass = C, natural = True }
+        , { note = C_sharp2, label = "C♯/D♭2", pitchClass = C_sharp, natural = False }
+        , { note = D2, label = "D2", pitchClass = D, natural = True }
+        , { note = D_sharp2, label = "D♯/E♭2", pitchClass = D_sharp, natural = False }
+        , { note = E2, label = "E2", pitchClass = E, natural = True }
+        , { note = F2, label = "F2", pitchClass = F, natural = True }
+        , { note = F_sharp2, label = "F♯/G♭2", pitchClass = F_sharp, natural = False }
+        , { note = G2, label = "G2", pitchClass = G, natural = True }
+        , { note = G_sharp2, label = "G♯/A♭2", pitchClass = G_sharp, natural = False }
+        , { note = A3, label = "A3", pitchClass = A, natural = True }
+        , { note = A_sharp3, label = "A♯/B♭3", pitchClass = A_sharp, natural = False }
+        , { note = B3, label = "B3", pitchClass = B, natural = True }
+        , { note = C3, label = "C3", pitchClass = C, natural = True }
+        , { note = C_sharp3, label = "C♯/D♭3", pitchClass = C_sharp, natural = False }
+        , { note = D3, label = "D3", pitchClass = D, natural = True }
+        , { note = D_sharp3, label = "D♯/E♭3", pitchClass = D_sharp, natural = False }
+        , { note = E3, label = "E3", pitchClass = E, natural = True }
+        , { note = F3, label = "F3", pitchClass = F, natural = True }
+        , { note = F_sharp3, label = "F♯/G♭3", pitchClass = F_sharp, natural = False }
+        , { note = G3, label = "G3", pitchClass = G, natural = True }
+        , { note = G_sharp3, label = "G♯/A♭3", pitchClass = G_sharp, natural = False }
+        , { note = A4, label = "A4", pitchClass = A, natural = True }
+        , { note = A_sharp4, label = "A♯/B♭4", pitchClass = A_sharp, natural = False }
+        , { note = B4, label = "B4", pitchClass = B, natural = True }
+        , { note = C4, label = "C4", pitchClass = C, natural = True }
+        , { note = C_sharp4, label = "C♯/D♭4", pitchClass = C_sharp, natural = False }
+        , { note = D4, label = "D4", pitchClass = D, natural = True }
+        , { note = D_sharp4, label = "D♯/E♭4", pitchClass = D_sharp, natural = False }
+        , { note = E4, label = "E4", pitchClass = E, natural = True }
+        , { note = F4, label = "F4", pitchClass = F, natural = True }
+        , { note = F_sharp4, label = "F♯/G♭4", pitchClass = F_sharp, natural = False }
+        , { note = G4, label = "G4", pitchClass = G, natural = True }
+        , { note = G_sharp4, label = "G♯/A♭4", pitchClass = G_sharp, natural = False }
+        , { note = A5, label = "A5", pitchClass = A, natural = True }
+        , { note = A_sharp5, label = "A♯/B♭5", pitchClass = A_sharp, natural = False }
+        , { note = B5, label = "B5", pitchClass = B, natural = True }
+        , { note = C5, label = "C5", pitchClass = C, natural = True }
+        , { note = C_sharp5, label = "C♯/D♭5", pitchClass = C_sharp, natural = False }
+        , { note = D5, label = "D5", pitchClass = D, natural = True }
+        , { note = D_sharp5, label = "D♯/E♭5", pitchClass = D_sharp, natural = False }
+        , { note = E5, label = "E5", pitchClass = E, natural = True }
+        , { note = F5, label = "F5", pitchClass = F, natural = True }
+        , { note = F_sharp5, label = "F♯/G♭5", pitchClass = F_sharp, natural = False }
+        , { note = G5, label = "G5", pitchClass = G, natural = True }
+        , { note = G_sharp5, label = "G♯/A♭5", pitchClass = G_sharp, natural = False }
+        , { note = A6, label = "A6", pitchClass = A, natural = True }
+        , { note = A_sharp6, label = "A♯/B♭6", pitchClass = A_sharp, natural = False }
+        , { note = B6, label = "B6", pitchClass = B, natural = True }
+        , { note = C6, label = "C6", pitchClass = C, natural = True }
+        , { note = C_sharp6, label = "C♯/D♭6", pitchClass = C_sharp, natural = False }
+        , { note = D6, label = "D6", pitchClass = D, natural = True }
+        , { note = D_sharp6, label = "D♯/E♭6", pitchClass = D_sharp, natural = False }
+        , { note = E6, label = "E6", pitchClass = E, natural = True }
+        , { note = F6, label = "F6", pitchClass = F, natural = True }
+        , { note = F_sharp6, label = "F♯/G♭6", pitchClass = F_sharp, natural = False }
+        , { note = G6, label = "G6", pitchClass = G, natural = True }
+        , { note = G_sharp6, label = "G♯/A♭6", pitchClass = G_sharp, natural = False }
+        , { note = A7, label = "A7", pitchClass = A, natural = True }
+        , { note = A_sharp7, label = "A♯/B♭7", pitchClass = A_sharp, natural = False }
+        , { note = B7, label = "B7", pitchClass = B, natural = True }
+        , { note = C7, label = "C7", pitchClass = C, natural = True }
+        , { note = C_sharp7, label = "C♯/D♭7", pitchClass = C_sharp, natural = False }
+        , { note = D7, label = "D7", pitchClass = D, natural = True }
+        , { note = D_sharp7, label = "D♯/E♭7", pitchClass = D_sharp, natural = False }
+        , { note = E7, label = "E7", pitchClass = E, natural = True }
+        , { note = F7, label = "F7", pitchClass = F, natural = True }
+        , { note = F_sharp7, label = "F♯/G♭7", pitchClass = F_sharp, natural = False }
+        , { note = G7, label = "G7", pitchClass = G, natural = True }
+        , { note = G_sharp7, label = "G♯/A♭7", pitchClass = G_sharp, natural = False }
+        , { note = C8, label = "C8", pitchClass = C, natural = True }
+        ]
+
+
+{-| Mapping of note data to commonly needed metadata for that note.
+-}
+getNoteMetadata : Note -> NoteMetadata
+getNoteMetadata note =
+    case Array.get (noteAsNumber note) noteMetadata of
+        Just metadata ->
+            metadata
+
+        -- This case should never hit, so we just return C1 to appease the
+        -- compiler.
+        Nothing ->
+            getNoteMetadata C1
+
+
+{-| Return the numeric representation of `note` to ues when comparing two
+notes.
+-}
+noteAsNumber : Note -> Int
+noteAsNumber note =
+    let
+        result =
+            noteMetadata
+                |> Array.toList
+                |> List.indexedMap Tuple.pair
+                |> Misc.find (\( _, x ) -> x.note == note)
+    in
+    case result of
+        Nothing ->
+            0
+
+        Just ( i, _ ) ->
+            i
+
+
+{-| Return true if all of the notes that comprise `chord` can be played on a
+piano whose keys begin at `start` and end at `end`.
+-}
+chordWithinRange : Note -> Note -> Chord -> Bool
+chordWithinRange start end chord =
+    case notesForChord chord of
+        Just notes ->
+            let
+                nums =
+                    List.map noteAsNumber notes
+
+                lo =
+                    List.minimum nums |> Maybe.withDefault (noteAsNumber start)
+
+                hi =
+                    List.maximum nums |> Maybe.withDefault (noteAsNumber end)
+            in
+            lo >= noteAsNumber start && hi < noteAsNumber end
+
+        Nothing ->
+            False
+
+
+{-| Return a list of all of the pitch classes that we know about.
+-}
+allPitchClasses : List PitchClass
+allPitchClasses =
+    [ C
+    , C_sharp
+    , D
+    , D_sharp
+    , E
+    , F
+    , F_sharp
+    , G
+    , G_sharp
+    , A
+    , A_sharp
+    , B
+    ]
+
+
+{-| Return a list of all of the chords that we know about.
+Only create chords from the range of notes delimited by the range `start` and
+`end`.
+-}
+allChords :
+    { start : Note
+    , end : Note
+    , inversions : List ChordInversion
+    , chordTypes : List ChordType
+    , pitchClasses : List PitchClass
+    }
+    -> List Chord
+allChords { start, end, inversions, chordTypes, pitchClasses } =
+    let
+        notes =
+            notesFromRange start end
+                |> List.filter (\note -> List.member (classifyNote note) pitchClasses)
+    in
+    notes
+        |> List.Extra.andThen
+            (\note ->
+                chordTypes
+                    |> List.Extra.andThen
+                        (\chordType ->
+                            inversions
+                                |> List.Extra.andThen
+                                    (\inversion ->
+                                        [ { note = note
+                                          , chordType = chordType
+                                          , chordInversion = inversion
+                                          }
+                                        ]
+                                    )
+                        )
+            )
+        |> List.filter (chordWithinRange start end)
+
+
+{-| Return a human-readable format of `note`.
+-}
+viewNote : Note -> String
+viewNote note =
+    note |> getNoteMetadata |> .label
+
+
+{-| Return a human-readable format of `chord`.
+-}
+viewChord : Chord -> String
+viewChord { note, chordType, chordInversion } =
+    viewPitchClass (classifyNote note) ++ " " ++ chordTypeName chordType ++ " " ++ inversionName chordInversion ++ " position"
+
+
+{-| Return a human-readable format of `pitchClass`.
+-}
+viewPitchClass : PitchClass -> String
+viewPitchClass pitchClass =
+    case pitchClass of
+        C ->
+            "C"
+
+        C_sharp ->
+            "C♯/D♭"
+
+        D ->
+            "D"
+
+        D_sharp ->
+            "D♯/E♭"
+
+        E ->
+            "E"
+
+        F ->
+            "F"
+
+        F_sharp ->
+            "F♯/G♭"
+
+        G ->
+            "G"
+
+        G_sharp ->
+            "G♯/A♭"
+
+        A ->
+            "A"
+
+        A_sharp ->
+            "A♯/B♭"
+
+        B ->
+            "B"
+
+
+viewMode : Mode -> String
+viewMode mode =
+    case mode of
+        MajorMode ->
+            "major"
+
+        MinorMode ->
+            "minor"
+
+        BluesMode ->
+            "blues"
+
+
+{-| Return the human-readable format of `key`.
+-}
+viewKey : Key -> String
+viewKey { pitchClass, mode } =
+    viewPitchClass pitchClass ++ " " ++ viewMode mode
+
+
+{-| Returns a pairing of a scale-degree to the type of chord at that scale
+degree.
+-}
+practiceChordsForMode : Mode -> Dict ScaleDegree ChordType
+practiceChordsForMode mode =
+    case mode of
+        MajorMode ->
+            Dict.fromList
+                [ ( 1, Major )
+                , ( 2, Minor )
+                , ( 3, Minor )
+                , ( 4, Major )
+                , ( 5, Major )
+                , ( 6, Minor )
+                , ( 7, Diminished )
+                ]
+
+        MinorMode ->
+            Dict.fromList
+                [ ( 1, Minor )
+                , ( 2, Diminished )
+                , ( 3, Major )
+                , ( 4, Minor )
+                , ( 5, Minor )
+                , ( 6, Major )
+                , ( 7, Major )
+                ]
+
+        BluesMode ->
+            Dict.fromList
+                [ ( 1, MajorDominant7 )
+
+                -- While many refer to the blues progression as a I-IV-V, the IV
+                -- chord is really a MajorDominant7 made from the third scale
+                -- degree.
+                , ( 3, MajorDominant7 )
+                , ( 5, MajorDominant7 )
+                ]
+
+
+{-| Returns a list of chords for a particular `key`.
+-}
+chordsForKey : Key -> List Chord
+chordsForKey key =
+    let
+        chords =
+            practiceChordsForMode key.mode
+    in
+    notesForKey key
+        |> List.indexedMap
+            (\i note ->
+                case Dict.get (i + 1) chords of
+                    Nothing ->
+                        Nothing
+
+                    Just chordType ->
+                        Just
+                            (allInversions
+                                |> List.Extra.andThen
+                                    (\inversion ->
+                                        [ { note = note
+                                          , chordType = chordType
+                                          , chordInversion = inversion
+                                          }
+                                        ]
+                                    )
+                            )
+            )
+        |> Maybe.Extra.values
+        |> List.concat
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/UI.elm b/users/wpcarro/website/sandbox/learnpianochords/src/UI.elm
new file mode 100644
index 000000000000..a6876c4f8a0d
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/UI.elm
@@ -0,0 +1,159 @@
+module UI exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Responsive
+import Tailwind
+
+
+type Color
+    = Primary
+    | Secondary
+
+
+bgForColor : Color -> String
+bgForColor color =
+    case color of
+        Primary ->
+            "bg-gray-600"
+
+        Secondary ->
+            "bg-gray-300"
+
+
+textForColor : Color -> String
+textForColor color =
+    case color of
+        Primary ->
+            "text-white"
+
+        Secondary ->
+            "text-black"
+
+
+simpleButton :
+    { label : String
+    , handleClick : msg
+    , color : Color
+    , classes : List String
+    }
+    -> Html msg
+simpleButton { label, handleClick, color, classes } =
+    let
+        buttonClasses =
+            [ bgForColor color
+            , textForColor color
+            , "py-10"
+            , "lg:py-6"
+            , "px-20"
+            , "lg:px-12"
+            , "rounded-lg"
+            , Responsive.h2
+            ]
+    in
+    button
+        [ class (Tailwind.use <| List.concat [ buttonClasses, classes ])
+        , onClick handleClick
+        ]
+        [ text label ]
+
+
+textToggleButton :
+    { label : String
+    , handleClick : msg
+    , classes : List String
+    , toggled : Bool
+    }
+    -> Html msg
+textToggleButton { label, toggled, handleClick, classes } =
+    let
+        ( textColor, textTreatment ) =
+            if toggled then
+                ( "text-red-600", "underline" )
+
+            else
+                ( "text-black", "no-underline" )
+
+        buttonClasses =
+            [ textColor
+            , textTreatment
+            , "py-8"
+            , "lg:py-5"
+            , "px-10"
+            , "lg:px-6"
+            , Responsive.h2
+            ]
+    in
+    button
+        [ class (Tailwind.use <| List.concat [ buttonClasses, classes ])
+        , onClick handleClick
+        ]
+        [ text label ]
+
+
+textField :
+    { placeholderText : String
+    , handleInput : String -> msg
+    , classes : List String
+    }
+    -> Html msg
+textField { placeholderText, handleInput, classes } =
+    let
+        inputClasses =
+            [ "w-full"
+            , "py-10"
+            , "lg:py-6"
+            , "px-16"
+            , "lg:px-10"
+            , "border"
+            , "rounded-lg"
+            , Responsive.h2
+            ]
+    in
+    input
+        [ class (Tailwind.use <| List.concat [ inputClasses, classes ])
+        , onInput handleInput
+        , placeholder placeholderText
+        ]
+        []
+
+
+overlayButton :
+    { label : String
+    , handleClick : msg
+    , isVisible : Bool
+    }
+    -> Html msg
+overlayButton { label, handleClick, isVisible } =
+    let
+        classes =
+            [ "fixed"
+            , "top-0"
+            , "left-0"
+            , "block"
+            , "z-40"
+            , "w-screen"
+            , "h-screen"
+            , Tailwind.if_ isVisible "opacity-100" "opacity-0"
+            ]
+    in
+    button
+        [ classes |> Tailwind.use |> class
+        , style "background-color" "rgba(0,0,0,1.0)"
+        , onClick handleClick
+        ]
+        [ h1
+            [ style "-webkit-text-stroke-width" "2px"
+            , style "-webkit-text-stroke-color" "black"
+            , class <|
+                Tailwind.use
+                    [ "transform"
+                    , "-rotate-90"
+                    , "text-white"
+                    , "font-mono"
+                    , Responsive.h1
+                    ]
+            ]
+            [ text label ]
+        ]
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/.envrc b/users/wpcarro/website/sandbox/learnpianochords/src/server/.envrc
new file mode 100644
index 000000000000..db08eac38e8e
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/.envrc
@@ -0,0 +1,6 @@
+source_up
+use_nix
+export SERVER_PORT=3000
+export CLIENT_PORT=8000
+export GOOGLE_CLIENT_ID="$(jq -j '.google | .clientId' < ~/briefcase/secrets.json)"
+export STRIPE_API_KEY="$(jq -j '.stripe | .apiKey' < ~/briefcase/secrets.json)"
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/.ghci b/users/wpcarro/website/sandbox/learnpianochords/src/server/.ghci
new file mode 100644
index 000000000000..151d070ca1a4
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/.ghci
@@ -0,0 +1,7 @@
+:set prompt "> "
+:set -Wall
+
+:set -XOverloadedStrings
+:set -XNoImplicitPrelude
+:set -XRecordWildCards
+:set -XTypeApplications
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/API.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/API.hs
new file mode 100644
index 000000000000..fe3671e7aa3e
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/API.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+--------------------------------------------------------------------------------
+module API where
+--------------------------------------------------------------------------------
+import Servant.API
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+type API = "verify"
+           :> ReqBody '[JSON] T.VerifyGoogleSignInRequest
+           :> Post '[JSON] NoContent
+      :<|> "create-payment-intent"
+           :> ReqBody '[JSON] T.PaymentIntent
+           :> Post '[JSON] T.CreatePaymentIntentResponse
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/App.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/App.hs
new file mode 100644
index 000000000000..e23757b01544
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/App.hs
@@ -0,0 +1,57 @@
+--------------------------------------------------------------------------------
+module App where
+--------------------------------------------------------------------------------
+import RIO hiding (Handler)
+import Servant
+import API
+import Data.String.Conversions (cs)
+import Control.Monad.IO.Class (liftIO)
+import Network.Wai.Middleware.Cors
+import GoogleSignIn (EncodedJWT(..), ValidationResult(..))
+import Utils
+
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified GoogleSignIn
+import qualified Stripe
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+server :: T.Context -> Server API
+server ctx@T.Context{..} = verifyGoogleSignIn
+                      :<|> createPaymentIntent
+  where
+    verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> Handler NoContent
+    verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do
+      validationResult <- liftIO $ GoogleSignIn.validateJWT False (EncodedJWT idToken)
+      case validationResult of
+        Valid _ -> do
+          -- If GoogleLinkedAccounts has email from JWT:
+          --   create a new session for email
+          -- Else:
+          --   Redirect the SPA to the sign-up / payment page
+          pure NoContent
+        err -> do
+          throwError err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
+
+    createPaymentIntent :: T.PaymentIntent -> Handler T.CreatePaymentIntentResponse
+    createPaymentIntent pmt = do
+      clientSecret <- liftIO $ Stripe.createPaymentIntent ctx pmt
+      pure T.CreatePaymentIntentResponse{..}
+
+run :: T.App
+run = do
+  ctx@T.Context{..} <- ask
+  ctx
+    |> server
+    |> serve (Proxy @ API)
+    |> cors (const $ Just corsPolicy)
+    |> Warp.run contextServerPort
+    |> liftIO
+  pure $ Right ()
+  where
+    corsPolicy :: CorsResourcePolicy
+    corsPolicy = simpleCorsResourcePolicy
+      { corsOrigins = Just (["http://localhost:8000"], True)
+      , corsMethods = simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"]
+      , corsRequestHeaders = simpleHeaders ++ ["Content-Type", "Authorization"]
+      }
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/Fixtures.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/Fixtures.hs
new file mode 100644
index 000000000000..7c153e422822
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/Fixtures.hs
@@ -0,0 +1,67 @@
+--------------------------------------------------------------------------------
+module Fixtures where
+--------------------------------------------------------------------------------
+import RIO
+import Web.JWT
+import Utils
+
+import qualified Data.Map as Map
+import qualified GoogleSignIn
+import qualified TestUtils
+import qualified Data.Time.Clock.POSIX as POSIX
+import qualified System.IO.Unsafe as Unsafe
+--------------------------------------------------------------------------------
+
+-- | These are the JWT fields that I'd like to overwrite in the `googleJWT`
+-- function.
+data JWTFields = JWTFields
+  { overwriteSigner :: Signer
+  , overwriteAuds :: [StringOrURI]
+  , overwriteIss :: StringOrURI
+  , overwriteExp :: NumericDate
+  }
+
+defaultJWTFields :: JWTFields
+defaultJWTFields = do
+  let tenDaysFromToday = POSIX.getPOSIXTime
+                         |> Unsafe.unsafePerformIO
+                         |> (\x -> x * 60 * 60 * 25 * 10)
+                         |> numericDate
+                         |> TestUtils.unsafeJust
+  JWTFields
+    { overwriteSigner = hmacSecret "secret"
+    , overwriteAuds = ["771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"]
+                      |> fmap TestUtils.unsafeStringOrURI
+    , overwriteIss = TestUtils.unsafeStringOrURI "accounts.google.com"
+    , overwriteExp = tenDaysFromToday
+    }
+
+googleJWT :: JWTFields -> GoogleSignIn.EncodedJWT
+googleJWT JWTFields{..} =
+  encodeSigned signer jwtHeader claimSet
+  |> GoogleSignIn.EncodedJWT
+  where
+    signer :: Signer
+    signer = overwriteSigner
+
+    jwtHeader :: JOSEHeader
+    jwtHeader = JOSEHeader
+      { typ = Just "JWT"
+      , cty = Nothing
+      , alg = Just RS256
+      , kid = Just "f05415b13acb9590f70df862765c655f5a7a019e"
+      }
+
+    claimSet :: JWTClaimsSet
+    claimSet = JWTClaimsSet
+      { iss = Just overwriteIss
+      , sub = stringOrURI "114079822315085727057"
+      , aud = overwriteAuds |> Right |> Just
+      -- TODO: Replace date creation with a human-readable date constructor.
+      , Web.JWT.exp = Just overwriteExp
+      , nbf = Nothing
+      -- TODO: Replace date creation with a human-readable date constructor.
+      , iat = numericDate 1596752853
+      , unregisteredClaims = ClaimsMap (Map.fromList [])
+      , jti = stringOrURI "0d3d7fa1fe05bedec0a91c88294936b2b4d1b13c"
+      }
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
new file mode 100644
index 000000000000..dcccadcb7022
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/GoogleSignIn.hs
@@ -0,0 +1,111 @@
+--------------------------------------------------------------------------------
+module GoogleSignIn where
+--------------------------------------------------------------------------------
+import RIO
+import Data.String.Conversions (cs)
+import Web.JWT
+import Utils
+
+import qualified Network.HTTP.Simple as HTTP
+import qualified Data.Text as Text
+import qualified Web.JWT as JWT
+import qualified Data.Time.Clock.POSIX as POSIX
+--------------------------------------------------------------------------------
+
+newtype EncodedJWT = EncodedJWT Text
+  deriving (Show)
+
+newtype DecodedJWT = DecodedJWT (JWT UnverifiedJWT)
+  deriving (Show)
+
+instance Eq DecodedJWT where
+  (DecodedJWT _) == (DecodedJWT _) = True
+
+data ValidationResult
+  = Valid DecodedJWT
+  | CannotDecodeJWT
+  | GoogleSaysInvalid Text
+  | NoMatchingClientIDs [StringOrURI]
+  | WrongIssuer StringOrURI
+  | StringOrURIParseFailure Text
+  | TimeConversionFailure
+  | MissingRequiredClaim Text
+  | StaleExpiry NumericDate
+  deriving (Eq, Show)
+
+-- | Returns True when the supplied `jwt` meets the following criteria:
+-- * The token has been signed by Google
+-- * The value of `aud` matches my Google client's ID
+-- * The value of `iss` matches is "accounts.google.com" or
+--   "https://accounts.google.com"
+-- * The `exp` time has not passed
+--
+-- Set `skipHTTP` to `True` to avoid making the network request for testing.
+validateJWT :: Bool
+           -> EncodedJWT
+           -> IO ValidationResult
+validateJWT skipHTTP (EncodedJWT encodedJWT) = do
+  case encodedJWT |> decode of
+    Nothing -> pure CannotDecodeJWT
+    Just jwt -> do
+      if skipHTTP then
+        continue jwt
+      else do
+        let request = "https://oauth2.googleapis.com/tokeninfo"
+                      |> HTTP.setRequestQueryString [ ( "id_token", Just (cs encodedJWT) ) ]
+        res <- HTTP.httpLBS request
+        if HTTP.getResponseStatusCode res /= 200 then
+          pure $ GoogleSaysInvalid (res |> HTTP.getResponseBody |> cs)
+        else
+          continue jwt
+  where
+    continue :: JWT UnverifiedJWT -> IO ValidationResult
+    continue jwt = do
+      let audValues :: [StringOrURI]
+          audValues = jwt |> claims |> auds
+          expectedClientID :: Text
+          expectedClientID = "771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"
+          expectedIssuers :: [Text]
+          expectedIssuers = [ "accounts.google.com"
+                            , "https://accounts.google.com"
+                            ]
+          mExpectedClientID :: Maybe StringOrURI
+          mExpectedClientID = stringOrURI expectedClientID
+          mExpectedIssuers :: Maybe [StringOrURI]
+          mExpectedIssuers = expectedIssuers |> traverse stringOrURI
+      case (mExpectedClientID, mExpectedIssuers) of
+        (Nothing, _) -> pure $ StringOrURIParseFailure expectedClientID
+        (_, Nothing) -> pure $ StringOrURIParseFailure (Text.unwords expectedIssuers)
+        (Just clientID, Just parsedIssuers) ->
+          -- TODO: Prefer reading clientID from a config. I'm thinking of the
+          -- AppContext type having my Configuration
+          if not $ clientID `elem` audValues then
+            pure $ NoMatchingClientIDs audValues
+          else
+            case (jwt |> claims |> iss, jwt |> claims |> JWT.exp) of
+              (Nothing, _) -> pure $ MissingRequiredClaim "iss"
+              (_, Nothing) -> pure $ MissingRequiredClaim "exp"
+              (Just jwtIssuer, Just jwtExpiry) ->
+                if not $ jwtIssuer `elem` parsedIssuers then
+                  pure $ WrongIssuer jwtIssuer
+                else do
+                  mCurrentTime <- POSIX.getPOSIXTime |> fmap numericDate
+                  case mCurrentTime of
+                    Nothing -> pure TimeConversionFailure
+                    Just currentTime ->
+                      if not $ currentTime <= jwtExpiry then
+                        pure $ StaleExpiry jwtExpiry
+                      else
+                        pure $ jwt |> DecodedJWT |> Valid
+
+-- | Attempt to explain the `ValidationResult` to a human.
+explainResult :: ValidationResult -> String
+explainResult (Valid _) = "Everything appears to be valid"
+explainResult CannotDecodeJWT = "We had difficulty decoding the provided JWT"
+explainResult (GoogleSaysInvalid x) = "After checking with Google, they claimed that the provided JWT was invalid: " ++ cs x
+explainResult (NoMatchingClientIDs audFields) = "None of the values in the `aud` field on the provided JWT match our client ID: " ++ show audFields
+explainResult (WrongIssuer issuer) = "The `iss` field in the provided JWT does not match what we expect: " ++ show issuer
+explainResult (StringOrURIParseFailure x) = "We had difficulty parsing values as URIs" ++ show x
+explainResult TimeConversionFailure = "We had difficulty converting the current time to a value we can use to compare with the JWT's `exp` field"
+explainResult (MissingRequiredClaim claim) = "Your JWT is missing the following claim: " ++ cs claim
+explainResult (StaleExpiry x) = "The `exp` field on your JWT has expired" ++ x |> show |> cs
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/Main.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/Main.hs
new file mode 100644
index 000000000000..228c3363bc59
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/Main.hs
@@ -0,0 +1,37 @@
+--------------------------------------------------------------------------------
+module Main where
+--------------------------------------------------------------------------------
+import RIO
+import Prelude (putStr, putStrLn)
+
+import qualified Types as T
+import qualified System.Envy as Envy
+import qualified App
+--------------------------------------------------------------------------------
+
+-- | Attempt to read environment variables from the system and initialize the
+-- Context data type for our application.
+getAppContext :: IO (Either String T.Context)
+getAppContext = do
+  mEnv <- Envy.decodeEnv
+  case mEnv of
+    Left err -> pure $ Left err
+    Right T.Env{..} -> pure $ Right T.Context
+      { contextGoogleClientID = envGoogleClientID
+      , contextStripeAPIKey = envStripeAPIKey
+      , contextServerPort = envServerPort
+      , contextClientPort = envClientPort
+      }
+
+main :: IO ()
+main = do
+  mContext <- getAppContext
+  case mContext of
+    Left err -> putStrLn err
+    Right ctx -> do
+      result <- runRIO ctx App.run
+      case result of
+        Left err -> do
+          putStr "Something went wrong when executing the application: "
+          putStrLn $ show err
+        Right _ -> putStrLn "The application successfully executed."
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/Spec.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/Spec.hs
new file mode 100644
index 000000000000..3c476bbf7b87
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/Spec.hs
@@ -0,0 +1,74 @@
+--------------------------------------------------------------------------------
+module Spec where
+--------------------------------------------------------------------------------
+import RIO
+import Test.Hspec
+import Utils
+import Web.JWT (numericDate, decode)
+import GoogleSignIn (EncodedJWT(..), DecodedJWT(..), ValidationResult(..))
+
+import qualified GoogleSignIn
+import qualified Fixtures as F
+import qualified TestUtils
+import qualified Data.Time.Clock.POSIX as POSIX
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = hspec $ do
+  describe "GoogleSignIn" $
+    describe "validateJWT" $ do
+      let validateJWT' = GoogleSignIn.validateJWT True
+      it "returns a decode error when an incorrectly encoded JWT is used" $ do
+        validateJWT' (GoogleSignIn.EncodedJWT "rubbish") `shouldReturn` CannotDecodeJWT
+
+      it "returns validation error when the aud field doesn't match my client ID" $ do
+        let auds = ["wrong-client-id"]
+                   |> fmap TestUtils.unsafeStringOrURI
+            encodedJWT = F.defaultJWTFields { F.overwriteAuds = auds }
+                         |> F.googleJWT
+        validateJWT' encodedJWT `shouldReturn` NoMatchingClientIDs auds
+
+      it "returns validation success when one of the aud fields matches my client ID" $ do
+        let auds = ["wrong-client-id", "771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com"]
+                   |> fmap TestUtils.unsafeStringOrURI
+            encodedJWT@(EncodedJWT jwt) =
+              F.defaultJWTFields { F.overwriteAuds = auds }
+              |> F.googleJWT
+            decodedJWT = jwt |> decode |> TestUtils.unsafeJust |> DecodedJWT
+        validateJWT' encodedJWT `shouldReturn` Valid decodedJWT
+
+      it "returns validation error when one of the iss field doesn't match accounts.google.com or https://accounts.google.com" $ do
+        let erroneousIssuer = TestUtils.unsafeStringOrURI "not-accounts.google.com"
+            encodedJWT = F.defaultJWTFields { F.overwriteIss = erroneousIssuer }
+                         |> F.googleJWT
+        validateJWT' encodedJWT `shouldReturn` WrongIssuer erroneousIssuer
+
+      it "returns validation success when the iss field matches accounts.google.com or https://accounts.google.com" $ do
+        let erroneousIssuer = TestUtils.unsafeStringOrURI "https://accounts.google.com"
+            encodedJWT@(EncodedJWT jwt) =
+              F.defaultJWTFields { F.overwriteIss = erroneousIssuer }
+              |> F.googleJWT
+            decodedJWT = jwt |> decode |> TestUtils.unsafeJust |> DecodedJWT
+        validateJWT' encodedJWT `shouldReturn` Valid decodedJWT
+
+      it "fails validation when the exp field has expired" $ do
+        let mErroneousExp = numericDate 0
+        case mErroneousExp of
+          Nothing -> True `shouldBe` False
+          Just erroneousExp -> do
+            let encodedJWT = F.defaultJWTFields { F.overwriteExp = erroneousExp }
+                             |> F.googleJWT
+            validateJWT' encodedJWT `shouldReturn` StaleExpiry erroneousExp
+
+      it "passes validation when the exp field is current" $ do
+        mFreshExp <- POSIX.getPOSIXTime
+                     |> fmap (\x -> x * 60 * 60 * 24 * 10) -- 10 days later
+                     |> fmap numericDate
+        case mFreshExp of
+          Nothing -> True `shouldBe` False
+          Just freshExp -> do
+            let encodedJWT@(EncodedJWT jwt) =
+                  F.defaultJWTFields { F.overwriteExp = freshExp }
+                  |> F.googleJWT
+                decodedJWT = jwt |> decode |> TestUtils.unsafeJust |> DecodedJWT
+            validateJWT' encodedJWT `shouldReturn` Valid decodedJWT
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/Stripe.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/Stripe.hs
new file mode 100644
index 000000000000..5370b90abebf
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/Stripe.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+--------------------------------------------------------------------------------
+module Stripe where
+--------------------------------------------------------------------------------
+import RIO
+import Prelude (print)
+import Data.String.Conversions (cs)
+import Data.Aeson
+import Network.HTTP.Req
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+endpoint :: Text -> Url 'Https
+endpoint slug =
+  https "api.stripe.com" /: "v1" /: slug
+
+post :: (FromJSON b) => Text -> Text -> T.PaymentIntent -> IO (JsonResponse b)
+post apiKey slug T.PaymentIntent{..} = runReq defaultHttpConfig $ do
+  let params = "amount" =: paymentIntentAmount
+            <> "currency" =: paymentIntentCurrency
+  req POST (endpoint slug) (ReqBodyUrlEnc params) jsonResponse (oAuth2Bearer (cs apiKey))
+
+createPaymentIntent :: T.Context -> T.PaymentIntent -> IO T.Secret
+createPaymentIntent T.Context{..} pmtIntent = do
+  res <- post contextStripeAPIKey "payment_intents" pmtIntent
+  let T.StripePaymentIntent{..} = responseBody res :: T.StripePaymentIntent
+  pure pmtIntentClientSecret
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/TestUtils.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/TestUtils.hs
new file mode 100644
index 000000000000..24054bf47afd
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/TestUtils.hs
@@ -0,0 +1,17 @@
+--------------------------------------------------------------------------------
+module TestUtils where
+--------------------------------------------------------------------------------
+import RIO
+import Web.JWT
+import Data.String.Conversions (cs)
+--------------------------------------------------------------------------------
+
+unsafeStringOrURI :: String -> StringOrURI
+unsafeStringOrURI x =
+  case stringOrURI (cs x) of
+    Nothing -> error $ "Failed to convert to StringOrURI: " ++ x
+    Just res -> res
+
+unsafeJust :: Maybe a -> a
+unsafeJust Nothing = error "Attempted to force a Nothing to be a something"
+unsafeJust (Just x) = x
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/Types.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/Types.hs
new file mode 100644
index 000000000000..4a72865153ab
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/Types.hs
@@ -0,0 +1,146 @@
+--------------------------------------------------------------------------------G
+module Types where
+--------------------------------------------------------------------------------
+import RIO
+import Data.Aeson
+import Network.HTTP.Req
+import Web.Internal.HttpApiData (ToHttpApiData(..))
+import System.Envy (FromEnv, fromEnv, env)
+--------------------------------------------------------------------------------
+
+-- | Read from .envrc
+data Env = Env
+  { envGoogleClientID :: !Text
+  , envServerPort :: !Int
+  , envClientPort :: !Int
+  , envStripeAPIKey :: !Text
+  } deriving (Eq, Show)
+
+instance FromEnv Env where
+  fromEnv _ = do
+    envGoogleClientID <- env "GOOGLE_CLIENT_ID"
+    envStripeAPIKey <- env "STRIPE_API_KEY"
+    envServerPort <- env "SERVER_PORT"
+    envClientPort <- env "CLIENT_PORT"
+    pure Env {..}
+
+-- | Application context: a combination of Env and additional values.
+data Context = Context
+  { contextGoogleClientID :: !Text
+  , contextStripeAPIKey :: !Text
+  , contextServerPort :: !Int
+  , contextClientPort :: !Int
+  }
+
+-- | Top-level except for our application, as RIO recommends defining.
+type Failure = ()
+
+-- | When our app executes along the "happy path" this is the type of result it
+-- produces.
+type Success = ()
+
+-- | This is our application monad.
+type AppM = RIO Context
+
+-- | The concrete type of our application.
+type App = AppM (Either Failure Success)
+
+data VerifyGoogleSignInRequest = VerifyGoogleSignInRequest
+  { idToken :: !Text
+  } deriving (Eq, Show)
+
+instance FromJSON VerifyGoogleSignInRequest where
+  parseJSON = withObject "VerifyGoogleSignInRequest" $ \x -> do
+    idToken <- x .: "idToken"
+    pure VerifyGoogleSignInRequest{..}
+
+data GoogleLinkedAccount = GoogleLinkedAccount
+  {
+  -- { googleLinkedAccountUUID :: UUID
+  -- , googleLinkedAccountEmail :: Email
+  -- , googleLinkedAccountTsCreated :: Timestamp
+    googleLinkedAccountGivenName :: !(Maybe Text)
+  , googleLinkedAccountFamilyName :: !(Maybe Text)
+  , googleLinkedAccountFullName :: !(Maybe Text)
+  -- , googleLinkedAccountPictureURL :: URL
+  -- , googleLinkedAccountLocale :: Maybe Locale
+  } deriving (Eq, Show)
+
+data PayingCustomer = PayingCustomer
+  {
+  -- { payingCustomerAccountUUID :: UUID
+  -- , payingCustomerTsCreated :: Timestamp
+  } deriving (Eq, Show)
+
+data Session = Session
+  {
+  -- { sessionUUID :: UUID
+  -- , sessionAccountUUID :: UUID
+  -- , sessionTsCreated :: Timestamp
+  } deriving (Eq, Show)
+
+data CurrencyCode = USD
+  deriving (Eq, Show)
+
+instance ToJSON CurrencyCode where
+  toJSON USD = String "usd"
+
+instance FromJSON CurrencyCode where
+  parseJSON = withText "CurrencyCode" $ \x ->
+    case x of
+      "usd" -> pure USD
+      _ -> fail "Expected a valid currency code like: \"usd\""
+
+instance ToHttpApiData CurrencyCode where
+  toQueryParam USD = "usd"
+
+data PaymentIntent = PaymentIntent
+  { paymentIntentAmount :: !Int
+  , paymentIntentCurrency :: !CurrencyCode
+  } deriving (Eq, Show)
+
+instance ToJSON PaymentIntent where
+  toJSON PaymentIntent{..} =
+    object [ "amount" .= paymentIntentAmount
+           , "currency" .= paymentIntentCurrency
+           ]
+
+instance FromJSON PaymentIntent where
+  parseJSON = withObject "" $ \x -> do
+    paymentIntentAmount <- x .: "amount"
+    paymentIntentCurrency <- x .: "currency"
+    pure PaymentIntent{..}
+
+instance QueryParam PaymentIntent where
+  queryParam = undefined
+
+-- All applications have their secrets... Using the secret type ensures that no
+-- sensitive information will get printed to the screen.
+newtype Secret = Secret Text deriving (Eq)
+
+instance Show Secret where
+  show (Secret _) = "[REDACTED]"
+
+instance ToJSON Secret where
+  toJSON (Secret x) = toJSON x
+
+instance FromJSON Secret where
+  parseJSON = withText "Secret" $ \x -> pure $ Secret x
+
+data CreatePaymentIntentResponse = CreatePaymentIntentResponse
+  { clientSecret :: Secret
+  } deriving (Eq, Show)
+
+instance ToJSON CreatePaymentIntentResponse where
+  toJSON CreatePaymentIntentResponse{..} =
+    object [ "clientSecret" .= clientSecret
+           ]
+
+data StripePaymentIntent = StripePaymentIntent
+  { pmtIntentClientSecret :: Secret
+  } deriving (Eq, Show)
+
+instance FromJSON StripePaymentIntent where
+  parseJSON = withObject "StripeCreatePaymentIntentResponse" $ \x -> do
+    pmtIntentClientSecret <- x .: "client_secret"
+    pure StripePaymentIntent{..}
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/Utils.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/Utils.hs
new file mode 100644
index 000000000000..2f401af2fb8f
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/Utils.hs
@@ -0,0 +1,8 @@
+--------------------------------------------------------------------------------
+module Utils where
+--------------------------------------------------------------------------------
+import Data.Function ((&))
+--------------------------------------------------------------------------------
+
+(|>) :: a -> (a -> b) -> b
+(|>) = (&)
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/default.nix b/users/wpcarro/website/sandbox/learnpianochords/src/server/default.nix
new file mode 100644
index 000000000000..87de69cbd627
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/default.nix
@@ -0,0 +1,28 @@
+let
+  briefcase = import <briefcase> {};
+in briefcase.buildHaskell.program {
+  name = "server";
+  srcs = builtins.path {
+    path = ./.;
+    name = "LearnPianoChords-server-src";
+  };
+  ghcExtensions = [
+    "OverloadedStrings"
+    "NoImplicitPrelude"
+    "RecordWildCards"
+    "TypeApplications"
+  ];
+  deps = hpkgs: with hpkgs; [
+    servant-server
+    aeson
+    wai-cors
+    warp
+    jwt
+    unordered-containers
+    base64
+    http-conduit
+    rio
+    envy
+    req
+  ];
+}
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/index.html b/users/wpcarro/website/sandbox/learnpianochords/src/server/index.html
new file mode 100644
index 000000000000..459a5c8c8250
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/index.html
@@ -0,0 +1,35 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="UTF-8" />
+    <title>Google Sign-in</title>
+    <script src="https://apis.google.com/js/platform.js" async defer></script>
+    <meta name="google-signin-client_id" content="771151720060-buofllhed98fgt0j22locma05e7rpngl.apps.googleusercontent.com">
+  </head>
+  <body>
+    <div class="g-signin2" data-onsuccess="onSignIn"></div>
+    <a href="#" onclick="signOut();">Sign out</a>
+    <script>
+     function onSignIn(googleUser) {
+       var idToken = googleUser.getAuthResponse().id_token;
+       fetch('http://localhost:3000/verify', {
+         method: 'POST',
+         headers: {
+           'Content-Type': 'application/json',
+         },
+         body: JSON.stringify({
+           idToken: idToken,
+         })
+       })
+         .then(x => console.log(x))
+         .catch(err => console.error(err));
+     }
+     function signOut() {
+       var auth2 = gapi.auth2.getAuthInstance();
+       auth2.signOut().then(function () {
+         console.log('User signed out.');
+       });
+     }
+    </script>
+  </body>
+</html>
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/init.sql b/users/wpcarro/website/sandbox/learnpianochords/src/server/init.sql
new file mode 100644
index 000000000000..c220bd440636
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/init.sql
@@ -0,0 +1,41 @@
+BEGIN TRANSACTION;
+
+DROP TABLE IF EXISTS GoogleLinkedAccounts;
+DROP TABLE IF EXISTS PayingCustomers;
+DROP TABLE IF EXISTS Sessions;
+
+-- Store some of the information that Google provides to us from the JWT.
+CREATE TABLE GoogleLinkedAccounts (
+  accountUUID TEXT CHECK(LENGTH(uuid) == 36) NOT NULL UNIQUE,
+  email TEXT NOT NULL UNIQUE,
+  tsCreated TEXT NOT NULL, -- 'YYYY-MM-DD HH:MM:SS'
+  givenName TEXT,
+  familyName TEXT,
+  fullName TEXT,
+  pictureURL TEXT,
+  locale TEXT,
+  PRIMARY KEY (accountUUID)
+);
+
+-- Track which of our customers have a paid account.
+-- Defines a one-to-one relationship between:
+--   GoogleLinkedAccounts and PayingCustomers
+CREATE TABLE PayingCustomers (
+  accountUUID TEXT,
+  tsCreated TEXT,
+  PRIMARY KEY (accountUUID),
+  FOREIGN KEY (accountUUID) REFERENCES GoogleLinkedAccounts ON DELETE CASCADE
+);
+
+-- Define mobile and web sessions for our users.
+-- Defines a one-to-many relationship between:
+--   GoogleLinkedAccounts and Sessions
+CREATE TABLE Sessions (
+  sessionUUID TEXT CHECK(LENGTH(sessionUUID) == 36) NOT NULL UNIQUE,
+  accountUUID TEXT,
+  tsCreated TEXT NOT NULL, -- 'YYYY-MM-DD HH:MM:SS'
+  PRIMARY KEY (sessionUUID)
+  FOREIGN KEY(accountUUID) REFERENCES GoogleLinkedAccounts ON DELETE CASCADE
+);
+
+COMMIT;
diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/shell.nix b/users/wpcarro/website/sandbox/learnpianochords/src/server/shell.nix
new file mode 100644
index 000000000000..ab470841e6c1
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/shell.nix
@@ -0,0 +1,18 @@
+let
+  briefcase = import <briefcase> {};
+in briefcase.buildHaskell.shell {
+  deps = hpkgs: with hpkgs; [
+    hspec
+    servant-server
+    aeson
+    wai-cors
+    warp
+    jwt
+    unordered-containers
+    base64
+    http-conduit
+    rio
+    envy
+    req
+  ];
+}