commit 6833d816e33b882c8fd3fac87b8167e3bab864db
parent c30098bccb7d0e7ba0a8b67a7577e9ca1d863058
Author: mtmn <miro@haravara.org>
Date: Fri, 17 Apr 2026 13:18:54 +0200
feat: use elm in frontend instead of halogen
Diffstat:
12 files changed, 1575 insertions(+), 935 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -1,5 +1,6 @@
bower_components/
node_modules/
+elm-stuff/
.pulp-cache/
output/
output-es/
diff --git a/docs/architecture.md b/docs/architecture.md
@@ -13,7 +13,7 @@ The server is built with PureScript running on Node.js. It handles several core
- **Cover Art Proxy**: A specialized endpoint that fetches, caches, and serves cover art, utilizing a multi-source fallback strategy (CAA → Last.fm → Discogs).
### Frontend
-A Single Page Application (SPA) built with PureScript and the [Halogen](https://github.com/purescript-halogen/purescript-halogen) framework.
+A Single Page Application (SPA) built with [Elm](https://elm-lang.org).
- **Real-time Updates**: Periodically refreshes the scrobble list.
- **Filtering & Search**: Supports deep filtering by genre, label, or release year.
- **Responsive UI**: Designed for both desktop and mobile viewing with a "retro-modern" aesthetic.
@@ -64,11 +64,10 @@ When a cover is requested:
## Tech Stack
-- **Language**: [PureScript](https://purescript.org)
-- **Frontend Framework**: [Halogen](https://github.com/purescript-halogen/purescript-halogen)
+- **Language**: [PureScript](https://purescript.org) (server), [Elm](https://elm-lang.org) (frontend)
- **Runtime**: [Node.js](https://nodejs.org)
- **Database**: [DuckDB](https://duckdb.org)
-- **Bundling**: [spago](https://github.com/purescript/spago) and [esbuild](https://esbuild.github.io/)
+- **Bundling**: [spago](https://github.com/purescript/spago) + [esbuild](https://esbuild.github.io/) (server), [elm make](https://guide.elm-lang.org/install/elm.html) (frontend)
- **Environment**: [Nix](https://nixos.org) for reproducible development shells and container builds
## Foreign Function Interface (FFI)
@@ -105,7 +104,7 @@ graph TD
end
subgraph Frontend
- UI[Halogen SPA]
+ UI[Elm SPA]
end
%% Scrobble Sync Flow
diff --git a/elm.json b/elm.json
@@ -0,0 +1,25 @@
+{
+ "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.1",
+ "elm/http": "2.0.0",
+ "elm/json": "1.1.4",
+ "elm/time": "1.0.0",
+ "elm/url": "1.0.0"
+ },
+ "indirect": {
+ "elm/bytes": "1.0.8",
+ "elm/file": "1.0.5",
+ "elm/virtual-dom": "1.0.5"
+ }
+ },
+ "test-dependencies": {
+ "direct": {},
+ "indirect": {}
+ }
+}
diff --git a/flake.nix b/flake.nix
@@ -33,6 +33,37 @@
hash = "sha256-ez73ecGmzf5d7EkamNZ9KT8u7e4yR7jSvdiGu4bGAHs=";
};
+ elmDeps = pkgs.stdenv.mkDerivation {
+ name = "corpus-elm-deps";
+
+ src = pkgs.lib.cleanSourceWith {
+ src = self;
+ filter = name: _type: let
+ baseName = baseNameOf (toString name);
+ in
+ pkgs.lib.elem baseName ["elm.json" "src" "Client.elm"];
+ };
+
+ nativeBuildInputs = with pkgs; [elmPackages.elm cacert];
+
+ outputHashAlgo = "sha256";
+ outputHashMode = "recursive";
+ outputHash = "sha256-7Qx/xkTOh4bPQuztHe8s82CrLmrFGNjhOqYqpW8Jbec=";
+
+ buildPhase = ''
+ export HOME=$TMPDIR
+ export SSL_CERT_FILE="${pkgs.cacert}/etc/ssl/certs/ca-bundle.crt"
+ export ELM_HOME=$HOME/.elm
+
+ elm make src/Client.elm --output=/dev/null
+ '';
+
+ installPhase = ''
+ mkdir -p $out
+ cp -r $HOME/.elm/0.19.1/packages $out/
+ '';
+ };
+
spagoDeps = pkgs.stdenv.mkDerivation {
name = "corpus-spago-deps";
@@ -48,7 +79,7 @@
outputHashAlgo = "sha256";
outputHashMode = "recursive";
- outputHash = "sha256-aJPjClixXOdbAZrAyb63Asvt3EyN6ov0Vv+DawvOSag=";
+ outputHash = "sha256-hlMN1T0s8otmQcj/Hinf/FpLWSjAIesE3n3krGBS/WU=";
buildPhase = ''
export HOME=$TMPDIR
@@ -100,7 +131,7 @@
version = "1.0.0";
inherit src;
- npmDepsHash = "sha256-q7+quD9rN0eTyPOLxjDvjQgFDnQtJanvSXzJEvMQfFk=";
+ npmDepsHash = "sha256-vxwqSgi9mIE/1skBkgk9CbcZa5In4mme1YUJoJs/7Lo=";
npmRebuildFlags = ["--ignore-scripts"];
nativeBuildInputs = with pkgs; [
@@ -108,6 +139,7 @@
nodejs
git
purescript
+ elmPackages.elm
];
buildPhase = ''
@@ -128,6 +160,11 @@
cp -r ${spagoRegistryIndex} $HOME/.cache/spago-nodejs/registry-index
chmod -R u+w $HOME/.cache/spago-nodejs
+ # Restore elm packages
+ mkdir -p $HOME/.elm/0.19.1
+ cp -r ${elmDeps}/packages $HOME/.elm/0.19.1/
+ chmod -R u+w $HOME/.elm
+
npm run build
'';
@@ -178,6 +215,7 @@
buildInputs = with pkgs; [
nodejs
purescript
+ elmPackages.elm
awscli2
duckdb
esbuild
diff --git a/package-lock.json b/package-lock.json
@@ -13,6 +13,7 @@
"duckdb": "^1.4.4"
},
"devDependencies": {
+ "elm": "^0.19.1",
"esbuild": "^0.28.0",
"purescript": "^0.15.16",
"purescript-language-server": "^0.18.0",
@@ -2208,6 +2209,23 @@
"node": ">=8"
}
},
+ "node_modules/ajv": {
+ "version": "6.14.0",
+ "resolved": "https://registry.npmjs.org/ajv/-/ajv-6.14.0.tgz",
+ "integrity": "sha512-IWrosm/yrn43eiKqkfkHis7QioDleaXQHdDVPKg0FSwwd/DuvyX79TZnFOnYpB7dcsFAMmtFztZuXPDvSePkFw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "fast-deep-equal": "^3.1.1",
+ "fast-json-stable-stringify": "^2.0.0",
+ "json-schema-traverse": "^0.4.1",
+ "uri-js": "^4.2.2"
+ },
+ "funding": {
+ "type": "github",
+ "url": "https://github.com/sponsors/epoberezkin"
+ }
+ },
"node_modules/ansi-escapes": {
"version": "4.3.2",
"resolved": "https://registry.npmjs.org/ansi-escapes/-/ansi-escapes-4.3.2.tgz",
@@ -2283,6 +2301,16 @@
"safer-buffer": "~2.1.0"
}
},
+ "node_modules/assert-plus": {
+ "version": "1.0.0",
+ "resolved": "https://registry.npmjs.org/assert-plus/-/assert-plus-1.0.0.tgz",
+ "integrity": "sha512-NfJ4UzBCcQGLDlQq7nHxH+tv3kyZ0hHQqF5BO6J7tNJeP5do1llPr8dZ8zHonfhAu0PHAdMkSo+8o0wxg9lZWw==",
+ "dev": true,
+ "license": "MIT",
+ "engines": {
+ "node": ">=0.8"
+ }
+ },
"node_modules/astral-regex": {
"version": "2.0.0",
"resolved": "https://registry.npmjs.org/astral-regex/-/astral-regex-2.0.0.tgz",
@@ -2293,6 +2321,30 @@
"node": ">=8"
}
},
+ "node_modules/asynckit": {
+ "version": "0.4.0",
+ "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz",
+ "integrity": "sha512-Oei9OH4tRh0YqU3GxhX79dM/mwVgvbZJaSNaRk+bshkj0S5cfHcgYakreBjrHwatXKbz+IoIdYLxrKim2MjW0Q==",
+ "dev": true,
+ "license": "MIT"
+ },
+ "node_modules/aws-sign2": {
+ "version": "0.7.0",
+ "resolved": "https://registry.npmjs.org/aws-sign2/-/aws-sign2-0.7.0.tgz",
+ "integrity": "sha512-08kcGqnYf/YmjoRhfxyu+CLxBjUtHLXLXX/vUfx9l2LYzG3c1m61nrpyFUZI6zeS+Li/wWMMidD9KgrqtGq3mA==",
+ "dev": true,
+ "license": "Apache-2.0",
+ "engines": {
+ "node": "*"
+ }
+ },
+ "node_modules/aws4": {
+ "version": "1.13.2",
+ "resolved": "https://registry.npmjs.org/aws4/-/aws4-1.13.2.tgz",
+ "integrity": "sha512-lHe62zvbTB5eEABUVi/AwVh0ZKY9rMMDhmm+eeyuuUQbQ3+J+fONVQOZyj+DdrvD4BY33uYniyRJ4UJIaSKAfw==",
+ "dev": true,
+ "license": "MIT"
+ },
"node_modules/balanced-match": {
"version": "1.0.2",
"resolved": "https://registry.npmjs.org/balanced-match/-/balanced-match-1.0.2.tgz",
@@ -2485,6 +2537,13 @@
"node": ">=8"
}
},
+ "node_modules/caseless": {
+ "version": "0.12.0",
+ "resolved": "https://registry.npmjs.org/caseless/-/caseless-0.12.0.tgz",
+ "integrity": "sha512-4tYFyifaFfGacoiObjJegolkwSU4xQNGbVgUiNYVUxbQ2x2lUsFvY4hVgVzGiIe6WLOPqycWXA40l+PWsxthUw==",
+ "dev": true,
+ "license": "Apache-2.0"
+ },
"node_modules/chalk": {
"version": "2.4.2",
"resolved": "https://registry.npmjs.org/chalk/-/chalk-2.4.2.tgz",
@@ -2557,6 +2616,19 @@
"color-support": "bin.js"
}
},
+ "node_modules/combined-stream": {
+ "version": "1.0.8",
+ "resolved": "https://registry.npmjs.org/combined-stream/-/combined-stream-1.0.8.tgz",
+ "integrity": "sha512-FQN4MRfuJeHf7cBbBMJFXhKSDq+2kAArBlmRBvcvFE5BB1HZKXtSFASDhdlz9zOYwxh8lDdnvmMOe/+5cdoEdg==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "delayed-stream": "~1.0.0"
+ },
+ "engines": {
+ "node": ">= 0.8"
+ }
+ },
"node_modules/concat-map": {
"version": "0.0.1",
"resolved": "https://registry.npmjs.org/concat-map/-/concat-map-0.0.1.tgz",
@@ -2721,6 +2793,19 @@
"dev": true,
"license": "MIT"
},
+ "node_modules/dashdash": {
+ "version": "1.14.1",
+ "resolved": "https://registry.npmjs.org/dashdash/-/dashdash-1.14.1.tgz",
+ "integrity": "sha512-jRFi8UDGo6j+odZiEpjazZaWqEal3w/basFjQHQEwVtZJGDpxbH1MeYluwCS8Xq5wmLJooDlMgvVarmWfGM44g==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "assert-plus": "^1.0.0"
+ },
+ "engines": {
+ "node": ">=0.10"
+ }
+ },
"node_modules/debug": {
"version": "4.4.3",
"resolved": "https://registry.npmjs.org/debug/-/debug-4.4.3.tgz",
@@ -2781,6 +2866,16 @@
"url": "https://github.com/sponsors/sindresorhus"
}
},
+ "node_modules/delayed-stream": {
+ "version": "1.0.0",
+ "resolved": "https://registry.npmjs.org/delayed-stream/-/delayed-stream-1.0.0.tgz",
+ "integrity": "sha512-ZySD7Nf91aLB0RxL4KGrKHBXl7Eds1DAmEdcoVawXnLD7SDhpNgtuII2aAkg7a7QS41jxPSZ17p4VdGnMHk3MQ==",
+ "dev": true,
+ "license": "MIT",
+ "engines": {
+ "node": ">=0.4.0"
+ }
+ },
"node_modules/delegates": {
"version": "1.0.0",
"resolved": "https://registry.npmjs.org/delegates/-/delegates-1.0.0.tgz",
@@ -2866,6 +2961,35 @@
"safe-buffer": "~5.1.0"
}
},
+ "node_modules/ecc-jsbn": {
+ "version": "0.1.2",
+ "resolved": "https://registry.npmjs.org/ecc-jsbn/-/ecc-jsbn-0.1.2.tgz",
+ "integrity": "sha512-eh9O+hwRHNbG4BLTjEl3nw044CkGm5X6LoaCf7LPp7UU8Qrt47JYNi6nPX8xjW97TKGKm1ouctg0QSpZe9qrnw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "jsbn": "~0.1.0",
+ "safer-buffer": "^2.1.0"
+ }
+ },
+ "node_modules/elm": {
+ "version": "0.19.1",
+ "resolved": "https://registry.npmjs.org/elm/-/elm-0.19.1.tgz",
+ "integrity": "sha512-rehOtJKZvoYDddlrd7AX5NAf0H+LUllnBg3AHaeaIOKWzw4W316d7Bkhlbo7aSG+hVUVWP2ihKwyYkDi589TfA==",
+ "deprecated": "package.json was changed upon upload, breaking things on Mac and Linux",
+ "dev": true,
+ "hasInstallScript": true,
+ "license": "BSD-3-Clause",
+ "dependencies": {
+ "request": "^2.88.0"
+ },
+ "bin": {
+ "elm": "bin/elm"
+ },
+ "engines": {
+ "node": ">=7.0.0"
+ }
+ },
"node_modules/emoji-regex": {
"version": "8.0.0",
"resolved": "https://registry.npmjs.org/emoji-regex/-/emoji-regex-8.0.0.tgz",
@@ -2999,6 +3123,37 @@
"integrity": "sha512-ZgEeZXj30q+I0EN+CbSSpIyPaJ5HVQD18Z1m+u1FXbAeT94mr1zw50q4q6jiiC447Nl/YTcIYSAftiGqetwXCA==",
"license": "Apache-2.0"
},
+ "node_modules/extend": {
+ "version": "3.0.2",
+ "resolved": "https://registry.npmjs.org/extend/-/extend-3.0.2.tgz",
+ "integrity": "sha512-fjquC59cD7CyW6urNXK0FBufkZcoiGG80wTuPujX590cB5Ttln20E2UB4S/WARVqhXffZl2LNgS+gQdPIIim/g==",
+ "dev": true,
+ "license": "MIT"
+ },
+ "node_modules/extsprintf": {
+ "version": "1.3.0",
+ "resolved": "https://registry.npmjs.org/extsprintf/-/extsprintf-1.3.0.tgz",
+ "integrity": "sha512-11Ndz7Nv+mvAC1j0ktTa7fAb0vLyGGX+rMHNBYQviQDGU0Hw7lhctJANqbPhu9nV9/izT/IntTgZ7Im/9LJs9g==",
+ "dev": true,
+ "engines": [
+ "node >=0.6.0"
+ ],
+ "license": "MIT"
+ },
+ "node_modules/fast-deep-equal": {
+ "version": "3.1.3",
+ "resolved": "https://registry.npmjs.org/fast-deep-equal/-/fast-deep-equal-3.1.3.tgz",
+ "integrity": "sha512-f3qQ9oQy9j2AhBe/H9VC91wLmKBCCU/gDOnKNAYG5hswO7BLKj09Hc5HYNz9cGI++xlpDCIgDaitVs03ATR84Q==",
+ "dev": true,
+ "license": "MIT"
+ },
+ "node_modules/fast-json-stable-stringify": {
+ "version": "2.1.0",
+ "resolved": "https://registry.npmjs.org/fast-json-stable-stringify/-/fast-json-stable-stringify-2.1.0.tgz",
+ "integrity": "sha512-lhd/wF+Lk98HZoTCtlVraHtfh5XYijIjalXck7saUtuanSDyLMxnHhSXEDJqHxD7msR8D0uCmqlkwjCV8xvwHw==",
+ "dev": true,
+ "license": "MIT"
+ },
"node_modules/fast-xml-builder": {
"version": "1.1.4",
"resolved": "https://registry.npmjs.org/fast-xml-builder/-/fast-xml-builder-1.1.4.tgz",
@@ -3149,6 +3304,31 @@
"url": "https://github.com/sponsors/isaacs"
}
},
+ "node_modules/forever-agent": {
+ "version": "0.6.1",
+ "resolved": "https://registry.npmjs.org/forever-agent/-/forever-agent-0.6.1.tgz",
+ "integrity": "sha512-j0KLYPhm6zeac4lz3oJ3o65qvgQCcPubiyotZrXqEaG4hNagNYO8qdlUrX5vwqv9ohqeT/Z3j6+yW067yWWdUw==",
+ "dev": true,
+ "license": "Apache-2.0",
+ "engines": {
+ "node": "*"
+ }
+ },
+ "node_modules/form-data": {
+ "version": "2.3.3",
+ "resolved": "https://registry.npmjs.org/form-data/-/form-data-2.3.3.tgz",
+ "integrity": "sha512-1lLKB2Mu3aGP1Q/2eCOx0fNbRMe7XdwktwOruhfqqd0rIJWwN4Dh+E3hrPSlDCXnSR7UtZ1N38rVXm+6+MEhJQ==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "asynckit": "^0.4.0",
+ "combined-stream": "^1.0.6",
+ "mime-types": "^2.1.12"
+ },
+ "engines": {
+ "node": ">= 0.12"
+ }
+ },
"node_modules/from2": {
"version": "2.3.0",
"resolved": "https://registry.npmjs.org/from2/-/from2-2.3.0.tgz",
@@ -3323,6 +3503,16 @@
"url": "https://github.com/sponsors/sindresorhus"
}
},
+ "node_modules/getpass": {
+ "version": "0.1.7",
+ "resolved": "https://registry.npmjs.org/getpass/-/getpass-0.1.7.tgz",
+ "integrity": "sha512-0fzj9JxOLfJ+XGLhR8ze3unN0KZCgZwiSSDz168VERjK8Wl8kVSdcu2kspd4s4wtAa1y/qrVRiAA0WclVsu0ng==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "assert-plus": "^1.0.0"
+ }
+ },
"node_modules/glob": {
"version": "7.2.3",
"resolved": "https://registry.npmjs.org/glob/-/glob-7.2.3.tgz",
@@ -3350,6 +3540,31 @@
"integrity": "sha512-RbJ5/jmFcNNCcDV5o9eTnBLJ/HszWV0P73bc+Ff4nS/rJj+YaS6IGyiOL0VoBYX+l1Wrl3k63h/KrH+nhJ0XvQ==",
"license": "ISC"
},
+ "node_modules/har-schema": {
+ "version": "2.0.0",
+ "resolved": "https://registry.npmjs.org/har-schema/-/har-schema-2.0.0.tgz",
+ "integrity": "sha512-Oqluz6zhGX8cyRaTQlFMPw80bSJVG2x/cFb8ZPhUILGgHka9SsokCCOQgpveePerqidZOrT14ipqfJb7ILcW5Q==",
+ "dev": true,
+ "license": "ISC",
+ "engines": {
+ "node": ">=4"
+ }
+ },
+ "node_modules/har-validator": {
+ "version": "5.1.5",
+ "resolved": "https://registry.npmjs.org/har-validator/-/har-validator-5.1.5.tgz",
+ "integrity": "sha512-nmT2T0lljbxdQZfspsno9hgrG3Uir6Ks5afism62poxqBM6sDnMEuPmzTq8XN0OEwqKLLdh1jQI3qyE66Nzb3w==",
+ "deprecated": "this library is no longer supported",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "ajv": "^6.12.3",
+ "har-schema": "^2.0.0"
+ },
+ "engines": {
+ "node": ">=6"
+ }
+ },
"node_modules/has-flag": {
"version": "3.0.0",
"resolved": "https://registry.npmjs.org/has-flag/-/has-flag-3.0.0.tgz",
@@ -3398,6 +3613,22 @@
"node": ">= 6.0.0"
}
},
+ "node_modules/http-signature": {
+ "version": "1.2.0",
+ "resolved": "https://registry.npmjs.org/http-signature/-/http-signature-1.2.0.tgz",
+ "integrity": "sha512-CAbnr6Rz4CYQkLYUtSNXxQPUH2gK8f3iWexVlsnMeD+GjlsQ0Xsy1cOX+mN3dtxYomRy21CiOzU8Uhw6OwncEQ==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "assert-plus": "^1.0.0",
+ "jsprim": "^1.2.2",
+ "sshpk": "^1.7.0"
+ },
+ "engines": {
+ "node": ">=0.8",
+ "npm": ">=1.3.7"
+ }
+ },
"node_modules/https-proxy-agent": {
"version": "7.0.6",
"resolved": "https://registry.npmjs.org/https-proxy-agent/-/https-proxy-agent-7.0.6.tgz",
@@ -3573,6 +3804,13 @@
"url": "https://github.com/sponsors/sindresorhus"
}
},
+ "node_modules/is-typedarray": {
+ "version": "1.0.0",
+ "resolved": "https://registry.npmjs.org/is-typedarray/-/is-typedarray-1.0.0.tgz",
+ "integrity": "sha512-cyA56iCMHAh5CdzjJIa4aohJyeO1YbwLi3Jc35MmRU6poroFjIGZzUzupGiRPOjgHg9TLu43xbpwXk523fMxKA==",
+ "dev": true,
+ "license": "MIT"
+ },
"node_modules/is-wsl": {
"version": "3.1.1",
"resolved": "https://registry.npmjs.org/is-wsl/-/is-wsl-3.1.1.tgz",
@@ -3602,6 +3840,13 @@
"integrity": "sha512-RHxMLp9lnKHGHRng9QFhRCMbYAcVpn69smSGcq3f36xjgVVWThj4qqLbTLlq7Ssj8B+fIQ1EuCEGI2lKsyQeIw==",
"license": "ISC"
},
+ "node_modules/isstream": {
+ "version": "0.1.2",
+ "resolved": "https://registry.npmjs.org/isstream/-/isstream-0.1.2.tgz",
+ "integrity": "sha512-Yljz7ffyPbrLpLngrMtZ7NduUgVvi6wG9RJ9IUcyCd59YQ911PBJphODUcbOVbqYfxe1wuYf/LJ8PauMRwsM/g==",
+ "dev": true,
+ "license": "MIT"
+ },
"node_modules/jackspeak": {
"version": "4.2.3",
"resolved": "https://registry.npmjs.org/jackspeak/-/jackspeak-4.2.3.tgz",
@@ -3618,6 +3863,34 @@
"url": "https://github.com/sponsors/isaacs"
}
},
+ "node_modules/jsbn": {
+ "version": "0.1.1",
+ "resolved": "https://registry.npmjs.org/jsbn/-/jsbn-0.1.1.tgz",
+ "integrity": "sha512-UVU9dibq2JcFWxQPA6KCqj5O42VOmAY3zQUfEKxU0KpTGXwNoCjkX1e13eHNvw/xPynt6pU0rZ1htjWTNTSXsg==",
+ "dev": true,
+ "license": "MIT"
+ },
+ "node_modules/json-schema": {
+ "version": "0.4.0",
+ "resolved": "https://registry.npmjs.org/json-schema/-/json-schema-0.4.0.tgz",
+ "integrity": "sha512-es94M3nTIfsEPisRafak+HDLfHXnKBhV3vU5eqPcS3flIWqcxJWgXHXiey3YrpaNsanY5ei1VoYEbOzijuq9BA==",
+ "dev": true,
+ "license": "(AFL-2.1 OR BSD-3-Clause)"
+ },
+ "node_modules/json-schema-traverse": {
+ "version": "0.4.1",
+ "resolved": "https://registry.npmjs.org/json-schema-traverse/-/json-schema-traverse-0.4.1.tgz",
+ "integrity": "sha512-xbbCH5dCYU5T8LcEhhuh7HJ88HXuW3qsI3Y0zOZFKfZEHcpWiHU/Jxzk629Brsab/mMiHQti9wMP+845RPe3Vg==",
+ "dev": true,
+ "license": "MIT"
+ },
+ "node_modules/json-stringify-safe": {
+ "version": "5.0.1",
+ "resolved": "https://registry.npmjs.org/json-stringify-safe/-/json-stringify-safe-5.0.1.tgz",
+ "integrity": "sha512-ZClg6AaYvamvYEE82d3Iyd3vSSIjQ+odgjaTzRuO3s7toCdFKczob2i0zCh7JE8kWn17yvAWhUVxvqGwUalsRA==",
+ "dev": true,
+ "license": "ISC"
+ },
"node_modules/jsonfile": {
"version": "6.2.0",
"resolved": "https://registry.npmjs.org/jsonfile/-/jsonfile-6.2.0.tgz",
@@ -3631,6 +3904,22 @@
"graceful-fs": "^4.1.6"
}
},
+ "node_modules/jsprim": {
+ "version": "1.4.2",
+ "resolved": "https://registry.npmjs.org/jsprim/-/jsprim-1.4.2.tgz",
+ "integrity": "sha512-P2bSOMAc/ciLz6DzgjVlGJP9+BrJWu5UDGK70C2iweC5QBIeFf0ZXRvGjEj2uYgrY2MkAAhsSWHDWlFtEroZWw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "assert-plus": "1.0.0",
+ "extsprintf": "1.3.0",
+ "json-schema": "0.4.0",
+ "verror": "1.10.0"
+ },
+ "engines": {
+ "node": ">=0.6.0"
+ }
+ },
"node_modules/linkify-it": {
"version": "5.0.0",
"resolved": "https://registry.npmjs.org/linkify-it/-/linkify-it-5.0.0.tgz",
@@ -3793,6 +4082,29 @@
"url": "https://github.com/sponsors/jonschlinkert"
}
},
+ "node_modules/mime-db": {
+ "version": "1.52.0",
+ "resolved": "https://registry.npmjs.org/mime-db/-/mime-db-1.52.0.tgz",
+ "integrity": "sha512-sPU4uV7dYlvtWJxwwxHD0PuihVNiE7TyAbQ5SWxDCB9mUYvOgroQOwYQQOKPJ8CIbE+1ETVlOoK1UC2nU3gYvg==",
+ "dev": true,
+ "license": "MIT",
+ "engines": {
+ "node": ">= 0.6"
+ }
+ },
+ "node_modules/mime-types": {
+ "version": "2.1.35",
+ "resolved": "https://registry.npmjs.org/mime-types/-/mime-types-2.1.35.tgz",
+ "integrity": "sha512-ZDY+bPm5zTTF+YpCrAU9nK0UgICYPT0QtT1NZWFv4s++TNkcgVaT0g6+4R2uI4MjQjzysHB1zxuWL50hzaeXiw==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "mime-db": "1.52.0"
+ },
+ "engines": {
+ "node": ">= 0.6"
+ }
+ },
"node_modules/mimic-fn": {
"version": "2.1.0",
"resolved": "https://registry.npmjs.org/mimic-fn/-/mimic-fn-2.1.0.tgz",
@@ -4165,6 +4477,16 @@
"node": "^12.13.0 || ^14.15.0 || >=16.0.0"
}
},
+ "node_modules/oauth-sign": {
+ "version": "0.9.0",
+ "resolved": "https://registry.npmjs.org/oauth-sign/-/oauth-sign-0.9.0.tgz",
+ "integrity": "sha512-fexhUFFPTGV8ybAtSIGbV6gOkSv8UtRbDBnAyLQw4QPKkgNlsH2ByPGtMUqdWkos6YCRmAqViwgZrJc/mRDzZQ==",
+ "dev": true,
+ "license": "Apache-2.0",
+ "engines": {
+ "node": "*"
+ }
+ },
"node_modules/once": {
"version": "1.4.0",
"resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz",
@@ -4357,6 +4679,13 @@
"node": ">=16 || 14 >=14.17"
}
},
+ "node_modules/performance-now": {
+ "version": "2.1.0",
+ "resolved": "https://registry.npmjs.org/performance-now/-/performance-now-2.1.0.tgz",
+ "integrity": "sha512-7EAHlyLHI56VEIdK57uwHdHKIaAGbnXPiw0yWbarQZOKaKpvUIgW0jWRVLiatnM+XXlSwsanIBH/hzGMJulMow==",
+ "dev": true,
+ "license": "MIT"
+ },
"node_modules/picomatch": {
"version": "4.0.4",
"resolved": "https://registry.npmjs.org/picomatch/-/picomatch-4.0.4.tgz",
@@ -4396,6 +4725,19 @@
"node": ">=10"
}
},
+ "node_modules/psl": {
+ "version": "1.15.0",
+ "resolved": "https://registry.npmjs.org/psl/-/psl-1.15.0.tgz",
+ "integrity": "sha512-JZd3gMVBAVQkSs6HdNZo9Sdo0LNcQeMNP3CozBJb3JYC/QUYZTnKxP+f8oWRX4rHP5EurWxqAHTSwUCjlNKa1w==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "punycode": "^2.3.1"
+ },
+ "funding": {
+ "url": "https://github.com/sponsors/lupomontero"
+ }
+ },
"node_modules/pump": {
"version": "3.0.4",
"resolved": "https://registry.npmjs.org/pump/-/pump-3.0.4.tgz",
@@ -4685,6 +5027,16 @@
"purs-tidy": "bin/index.js"
}
},
+ "node_modules/qs": {
+ "version": "6.5.5",
+ "resolved": "https://registry.npmjs.org/qs/-/qs-6.5.5.tgz",
+ "integrity": "sha512-mzR4sElr1bfCaPJe7m8ilJ6ZXdDaGoObcYR0ZHSsktM/Lt21MVHj5De30GQH2eiZ1qGRTO7LCAzQsUeXTNexWQ==",
+ "dev": true,
+ "license": "BSD-3-Clause",
+ "engines": {
+ "node": ">=0.6"
+ }
+ },
"node_modules/queue-microtask": {
"version": "1.2.3",
"resolved": "https://registry.npmjs.org/queue-microtask/-/queue-microtask-1.2.3.tgz",
@@ -4730,6 +5082,50 @@
"node": ">= 0.8.0"
}
},
+ "node_modules/request": {
+ "version": "2.88.2",
+ "resolved": "https://registry.npmjs.org/request/-/request-2.88.2.tgz",
+ "integrity": "sha512-MsvtOrfG9ZcrOwAW+Qi+F6HbD0CWXEh9ou77uOb7FM2WPhwT7smM833PzanhJLsgXjN89Ir6V2PczXNnMpwKhw==",
+ "deprecated": "request has been deprecated, see https://github.com/request/request/issues/3142",
+ "dev": true,
+ "license": "Apache-2.0",
+ "dependencies": {
+ "aws-sign2": "~0.7.0",
+ "aws4": "^1.8.0",
+ "caseless": "~0.12.0",
+ "combined-stream": "~1.0.6",
+ "extend": "~3.0.2",
+ "forever-agent": "~0.6.1",
+ "form-data": "~2.3.2",
+ "har-validator": "~5.1.3",
+ "http-signature": "~1.2.0",
+ "is-typedarray": "~1.0.0",
+ "isstream": "~0.1.2",
+ "json-stringify-safe": "~5.0.1",
+ "mime-types": "~2.1.19",
+ "oauth-sign": "~0.9.0",
+ "performance-now": "^2.1.0",
+ "qs": "~6.5.2",
+ "safe-buffer": "^5.1.2",
+ "tough-cookie": "~2.5.0",
+ "tunnel-agent": "^0.6.0",
+ "uuid": "^3.3.2"
+ },
+ "engines": {
+ "node": ">= 6"
+ }
+ },
+ "node_modules/request/node_modules/uuid": {
+ "version": "3.4.0",
+ "resolved": "https://registry.npmjs.org/uuid/-/uuid-3.4.0.tgz",
+ "integrity": "sha512-HjSDRw6gZE5JMggctHBcjVak08+KEVhSIiDzFnT9S9aegmp85S/bReBVTb4QTFaRNptJ9kuYaNhnbNEOkbKb/A==",
+ "deprecated": "Please upgrade to version 7 or higher. Older versions may use Math.random() in certain circumstances, which is known to be problematic. See https://v8.dev/blog/math-random for details.",
+ "dev": true,
+ "license": "MIT",
+ "bin": {
+ "uuid": "bin/uuid"
+ }
+ },
"node_modules/restore-cursor": {
"version": "3.1.0",
"resolved": "https://registry.npmjs.org/restore-cursor/-/restore-cursor-3.1.0.tgz",
@@ -5202,6 +5598,32 @@
"nan": "^2.23.0"
}
},
+ "node_modules/sshpk": {
+ "version": "1.18.0",
+ "resolved": "https://registry.npmjs.org/sshpk/-/sshpk-1.18.0.tgz",
+ "integrity": "sha512-2p2KJZTSqQ/I3+HX42EpYOa2l3f8Erv8MWKsy2I9uf4wA7yFIkXRffYdsx86y6z4vHtV8u7g+pPlr8/4ouAxsQ==",
+ "dev": true,
+ "license": "MIT",
+ "dependencies": {
+ "asn1": "~0.2.3",
+ "assert-plus": "^1.0.0",
+ "bcrypt-pbkdf": "^1.0.0",
+ "dashdash": "^1.12.0",
+ "ecc-jsbn": "~0.1.1",
+ "getpass": "^0.1.1",
+ "jsbn": "~0.1.0",
+ "safer-buffer": "^2.0.2",
+ "tweetnacl": "~0.14.0"
+ },
+ "bin": {
+ "sshpk-conv": "bin/sshpk-conv",
+ "sshpk-sign": "bin/sshpk-sign",
+ "sshpk-verify": "bin/sshpk-verify"
+ },
+ "engines": {
+ "node": ">=0.10.0"
+ }
+ },
"node_modules/ssri": {
"version": "9.0.1",
"resolved": "https://registry.npmjs.org/ssri/-/ssri-9.0.1.tgz",
@@ -5424,6 +5846,20 @@
"node": ">=8.0"
}
},
+ "node_modules/tough-cookie": {
+ "version": "2.5.0",
+ "resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.5.0.tgz",
+ "integrity": "sha512-nlLsUzgm1kfLXSXfRZMc1KLAugd4hqJHDTvc2hDIwS3mZAfMEuMbc03SujMF+GEcpaX/qboeycw6iO8JwVv2+g==",
+ "dev": true,
+ "license": "BSD-3-Clause",
+ "dependencies": {
+ "psl": "^1.1.28",
+ "punycode": "^2.1.1"
+ },
+ "engines": {
+ "node": ">=0.8"
+ }
+ },
"node_modules/tr46": {
"version": "0.0.3",
"resolved": "https://registry.npmjs.org/tr46/-/tr46-0.0.3.tgz",
@@ -5436,6 +5872,19 @@
"integrity": "sha512-oJFu94HQb+KVduSUQL7wnpmqnfmLsOA/nAh6b6EH0wCEoK0/mPeXU6c3wKDV83MkOuHPRHtSXKKU99IBazS/2w==",
"license": "0BSD"
},
+ "node_modules/tunnel-agent": {
+ "version": "0.6.0",
+ "resolved": "https://registry.npmjs.org/tunnel-agent/-/tunnel-agent-0.6.0.tgz",
+ "integrity": "sha512-McnNiV1l8RYeY8tBgEpuodCC1mLUdbSN+CYBL7kJsJNInOP8UjDDEwdk6Mw60vdLLrr5NHKZhMAOSrR2NZuQ+w==",
+ "dev": true,
+ "license": "Apache-2.0",
+ "dependencies": {
+ "safe-buffer": "^5.0.1"
+ },
+ "engines": {
+ "node": "*"
+ }
+ },
"node_modules/tweetnacl": {
"version": "0.14.5",
"resolved": "https://registry.npmjs.org/tweetnacl/-/tweetnacl-0.14.5.tgz",
@@ -5504,6 +5953,16 @@
"node": ">= 10.0.0"
}
},
+ "node_modules/uri-js": {
+ "version": "4.4.1",
+ "resolved": "https://registry.npmjs.org/uri-js/-/uri-js-4.4.1.tgz",
+ "integrity": "sha512-7rKUyy33Q1yc98pQ1DAmLtwX109F7TIfWlW1Ydo8Wl1ii1SeHieeh0HHfPeL2fMXK6z0s8ecKs9frCuLJvndBg==",
+ "dev": true,
+ "license": "BSD-2-Clause",
+ "dependencies": {
+ "punycode": "^2.1.0"
+ }
+ },
"node_modules/util-deprecate": {
"version": "1.0.2",
"resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz",
@@ -5524,6 +5983,28 @@
"uuid": "dist/bin/uuid"
}
},
+ "node_modules/verror": {
+ "version": "1.10.0",
+ "resolved": "https://registry.npmjs.org/verror/-/verror-1.10.0.tgz",
+ "integrity": "sha512-ZZKSmDAEFOijERBLkmYfJ+vmk3w+7hOLYDNkRCuRuMJGEmqYNCNLyBBFwWKVMhfwaEF3WOd0Zlw86U/WC/+nYw==",
+ "dev": true,
+ "engines": [
+ "node >=0.6.0"
+ ],
+ "license": "MIT",
+ "dependencies": {
+ "assert-plus": "^1.0.0",
+ "core-util-is": "1.0.2",
+ "extsprintf": "^1.2.0"
+ }
+ },
+ "node_modules/verror/node_modules/core-util-is": {
+ "version": "1.0.2",
+ "resolved": "https://registry.npmjs.org/core-util-is/-/core-util-is-1.0.2.tgz",
+ "integrity": "sha512-3lqz5YjWTYnW6dlDa5TLaTCcShfar1e40rmcJVwCBJC6mWlFuj0eCHIElmG1g5kyuJ/GD+8Wn4FFCcz4gJPfaQ==",
+ "dev": true,
+ "license": "MIT"
+ },
"node_modules/vscode-jsonrpc": {
"version": "8.2.1",
"resolved": "https://registry.npmjs.org/vscode-jsonrpc/-/vscode-jsonrpc-8.2.1.tgz",
diff --git a/package.json b/package.json
@@ -1,15 +1,16 @@
{
"name": "corpus",
"version": "1.0.0",
- "description": "ListenBrainz frontend in PureScript",
+ "description": "ListenBrainz scrobble viewer",
"main": "index.js",
"type": "module",
"scripts": {
- "build": "npx spago build && npx esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:duckdb --external:@aws-sdk/client-s3 && npx spago bundle --module Client --outfile client.js --platform browser",
+ "build": "npx spago build && npx esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:duckdb --external:@aws-sdk/client-s3 && elm make src/Client.elm --output=client.js",
"test": "npx spago test",
"tidy": "purs-tidy format-in-place src/**/*.purs"
},
"devDependencies": {
+ "elm": "^0.19.1",
"esbuild": "^0.28.0",
"purescript": "^0.15.16",
"purescript-language-server": "^0.18.0",
diff --git a/spago.lock b/spago.lock
@@ -7,8 +7,6 @@
"dependencies": [
"aff",
"aff-retry",
- "affjax",
- "affjax-web",
"argonaut",
"argonaut-core",
"arrays",
@@ -21,7 +19,6 @@
"fetch-argonaut",
"foreign-object",
"formatters",
- "halogen",
"http-methods",
"integers",
"js-uri",
@@ -36,13 +33,10 @@
"node-streams",
"node-url",
"now",
- "ordered-collections",
"prelude",
"strings",
"tailrec",
"unsafe-coerce",
- "web-dom",
- "web-html",
"web-url"
]
},
@@ -64,7 +58,7 @@
},
"package_set": {
"address": {
- "registry": "75.9.0"
+ "registry": "76.0.0"
},
"compiler": ">=0.15.15 <0.16.0",
"content": {
@@ -549,7 +543,7 @@
"systemd-journald": "0.3.0",
"tagged": "4.0.2",
"tailrec": "6.1.0",
- "tanstack-query": "2.0.1",
+ "tanstack-query": "3.0.0",
"tecton": "0.2.1",
"tecton-halogen": "0.2.0",
"temporal": "0.1.0",
@@ -691,7 +685,7 @@
"yoga-redis": "0.1.0",
"yoga-shadcn": "1.0.5",
"yoga-sql-types": "0.1.0",
- "yoga-sqlite": "0.3.0",
+ "yoga-sqlite": "0.3.2",
"yoga-sse": "0.1.1",
"yoga-subtlecrypto": "0.1.0",
"yoga-test-docker": "0.1.2",
@@ -747,48 +741,6 @@
"transformers"
]
},
- "affjax": {
- "type": "registry",
- "version": "13.0.0",
- "integrity": "sha256-dpOV8ELNqUVBwxE6eKFdnFky+sLwPFANrFUzIxQablk=",
- "dependencies": [
- "aff",
- "argonaut-core",
- "arraybuffer-types",
- "arrays",
- "control",
- "datetime",
- "either",
- "exceptions",
- "foldable-traversable",
- "foreign",
- "form-urlencoded",
- "functions",
- "http-methods",
- "lists",
- "maybe",
- "media-types",
- "newtype",
- "nullable",
- "prelude",
- "transformers",
- "web-dom",
- "web-file",
- "web-xhr"
- ]
- },
- "affjax-web": {
- "type": "registry",
- "version": "1.0.0",
- "integrity": "sha256-sHg+G50LDoZYG6UHvUiH1ZLT/UHIXaEF5DUBaPXxtxM=",
- "dependencies": [
- "aff",
- "affjax",
- "either",
- "maybe",
- "prelude"
- ]
- },
"ansi": {
"type": "registry",
"version": "7.0.0",
@@ -1016,23 +968,6 @@
"type-equality"
]
},
- "dom-indexed": {
- "type": "registry",
- "version": "13.0.0",
- "integrity": "sha256-Tr9uDQdmKN4TUGMg1/4KzsVu5zPa8OqKB4N6/S2a8vU=",
- "dependencies": [
- "datetime",
- "media-types",
- "prelude",
- "strings",
- "web-clipboard",
- "web-events",
- "web-html",
- "web-pointerevents",
- "web-touchevents",
- "web-uievents"
- ]
- },
"effect": {
"type": "registry",
"version": "4.0.0",
@@ -1202,20 +1137,6 @@
"transformers"
]
},
- "form-urlencoded": {
- "type": "registry",
- "version": "7.0.0",
- "integrity": "sha256-+8F0S6thSLsC1GfQiTdTt6jyTMuhsgKLciBUzde9aFU=",
- "dependencies": [
- "foldable-traversable",
- "js-uri",
- "maybe",
- "newtype",
- "prelude",
- "strings",
- "tuples"
- ]
- },
"formatters": {
"type": "registry",
"version": "7.0.0",
@@ -1263,23 +1184,6 @@
"unsafe-coerce"
]
},
- "freeap": {
- "type": "registry",
- "version": "7.0.0",
- "integrity": "sha256-e7SiV9rg+rVARsU9cxA/02sps7ubogvVgYwj8nWosX4=",
- "dependencies": [
- "const",
- "either",
- "gen",
- "lists",
- "newtype",
- "nonempty",
- "prelude",
- "tailrec",
- "tuples",
- "unsafe-coerce"
- ]
- },
"functions": {
"type": "registry",
"version": "6.0.0",
@@ -1325,92 +1229,6 @@
"unfoldable"
]
},
- "halogen": {
- "type": "registry",
- "version": "7.0.0",
- "integrity": "sha256-YrUm27QEiE1DyGaGJ5MNLVg4H/P3gnX/NVv1gRtWjB4=",
- "dependencies": [
- "aff",
- "bifunctors",
- "console",
- "control",
- "dom-indexed",
- "effect",
- "either",
- "exceptions",
- "foldable-traversable",
- "foreign",
- "fork",
- "free",
- "freeap",
- "functions",
- "halogen-subscriptions",
- "halogen-vdom",
- "lazy",
- "lists",
- "maybe",
- "media-types",
- "newtype",
- "ordered-collections",
- "parallel",
- "prelude",
- "profunctor",
- "refs",
- "strings",
- "tailrec",
- "transformers",
- "tuples",
- "unfoldable",
- "unsafe-coerce",
- "unsafe-reference",
- "web-clipboard",
- "web-dom",
- "web-events",
- "web-file",
- "web-html",
- "web-touchevents",
- "web-uievents"
- ]
- },
- "halogen-subscriptions": {
- "type": "registry",
- "version": "2.0.0",
- "integrity": "sha256-1eBtVZENgGtKuOY9H0iuYD3dO1CSqmOIyhYe4OhypOU=",
- "dependencies": [
- "arrays",
- "contravariant",
- "control",
- "effect",
- "foldable-traversable",
- "maybe",
- "prelude",
- "refs",
- "safe-coerce",
- "unsafe-reference"
- ]
- },
- "halogen-vdom": {
- "type": "registry",
- "version": "8.0.0",
- "integrity": "sha256-jk6aj/tH630skFVk6mB5Q+0g2zb897KX72T63fJhJ2Y=",
- "dependencies": [
- "arrays",
- "bifunctors",
- "effect",
- "foreign",
- "foreign-object",
- "functions",
- "maybe",
- "newtype",
- "nullable",
- "prelude",
- "refs",
- "tuples",
- "unsafe-coerce",
- "web-dom",
- "web-events"
- ]
- },
"http-methods": {
"type": "registry",
"version": "6.0.0",
@@ -2289,45 +2107,6 @@
"integrity": "sha256-0L1QsaY20OILjfU5TV72d3U/tSjhmL9hJ32WMp857Lk=",
"dependencies": []
},
- "unsafe-reference": {
- "type": "registry",
- "version": "5.0.0",
- "integrity": "sha256-ttSJTQUnK8AK2eGOsfRxLUJEDPL6pnmExjbiOqfwC6I=",
- "dependencies": [
- "prelude"
- ]
- },
- "web-clipboard": {
- "type": "registry",
- "version": "6.0.0",
- "integrity": "sha256-3CV0txwKddLoj8qBrRjUWbiX0M8+rnOpi1iApr5PEb0=",
- "dependencies": [
- "effect",
- "functions",
- "js-promise",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events",
- "web-html"
- ]
- },
- "web-dom": {
- "type": "registry",
- "version": "6.0.0",
- "integrity": "sha256-rVeqkxChkjqisDvOujy9BMEgGqJkwX3t6g21bXfiG5o=",
- "dependencies": [
- "effect",
- "enums",
- "maybe",
- "newtype",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events"
- ]
- },
"web-events": {
"type": "registry",
"version": "4.0.0",
@@ -2367,56 +2146,6 @@
"web-events"
]
},
- "web-html": {
- "type": "registry",
- "version": "4.1.1",
- "integrity": "sha256-yOuZJGUxFrivHKpo/jKuKzFZaq6PPPE64ftSysXFssk=",
- "dependencies": [
- "effect",
- "enums",
- "foreign",
- "functions",
- "js-date",
- "maybe",
- "media-types",
- "newtype",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-dom",
- "web-events",
- "web-file",
- "web-storage"
- ]
- },
- "web-pointerevents": {
- "type": "registry",
- "version": "2.0.0",
- "integrity": "sha256-mQbm1V36u3It2WdYMAXtzLBJl3uRAhN4BjeZTw3LWN8=",
- "dependencies": [
- "effect",
- "maybe",
- "prelude",
- "unsafe-coerce",
- "web-dom",
- "web-events",
- "web-html",
- "web-uievents"
- ]
- },
- "web-storage": {
- "type": "registry",
- "version": "5.0.0",
- "integrity": "sha256-YJfos55oeKtBStNfoWfeflSy8j+4IDym5eaZtIY7YM4=",
- "dependencies": [
- "effect",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events"
- ]
- },
"web-streams": {
"type": "registry",
"version": "4.0.0",
@@ -2432,35 +2161,6 @@
"tuples"
]
},
- "web-touchevents": {
- "type": "registry",
- "version": "4.0.0",
- "integrity": "sha256-H02c53BJlHDlAgogj/x8bM7PagJjhMMrMPYy9I7Rf0s=",
- "dependencies": [
- "functions",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events",
- "web-uievents"
- ]
- },
- "web-uievents": {
- "type": "registry",
- "version": "5.0.0",
- "integrity": "sha256-yh9uVLIGu8wE1+jwLehtfsRfR1eyiShhIMMhBPqKybE=",
- "dependencies": [
- "effect",
- "enums",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events",
- "web-html"
- ]
- },
"web-url": {
"type": "registry",
"version": "2.0.0",
@@ -2471,30 +2171,6 @@
"prelude",
"tuples"
]
- },
- "web-xhr": {
- "type": "registry",
- "version": "5.0.1",
- "integrity": "sha256-gxQgeGwvF/NyGdw0FJ9IzXI3gqIMNb8oQO8X+p5jDyw=",
- "dependencies": [
- "arraybuffer-types",
- "datetime",
- "effect",
- "either",
- "enums",
- "foreign",
- "http-methods",
- "maybe",
- "media-types",
- "newtype",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-dom",
- "web-events",
- "web-file",
- "web-html"
- ]
}
}
}
diff --git a/spago.yaml b/spago.yaml
@@ -2,8 +2,7 @@ package:
name: corpus
dependencies:
- aff
- - affjax
- - affjax-web
+ - aff-retry
- argonaut
- argonaut-core
- arrays
@@ -16,7 +15,6 @@ package:
- fetch-argonaut
- foreign-object
- formatters
- - halogen
- http-methods
- integers
- js-uri
@@ -31,14 +29,10 @@ package:
- node-streams
- node-url
- now
- - ordered-collections
- - aff-retry
- prelude
- strings
- tailrec
- unsafe-coerce
- - web-dom
- - web-html
- web-url
test:
main: Test.Main
@@ -55,5 +49,5 @@ package:
- node-process
workspace:
packageSet:
- registry: 75.9.0
+ registry: 76.0.0
extraPackages: {}
diff --git a/src/Client.elm b/src/Client.elm
@@ -0,0 +1,1007 @@
+port module Client exposing (main)
+
+import Browser
+import Html exposing (..)
+import Html.Attributes as Attr exposing (class, disabled, href, placeholder, src, style, target, type_, value)
+import Html.Events exposing (onClick, on, onInput)
+import Http
+import Json.Decode as D exposing (Decoder)
+import List
+import Maybe
+import Set exposing (Set)
+import String
+import Task
+import Time
+import Url
+
+
+port pushUrl : String -> Cmd msg
+
+
+main : Program String Model Msg
+main =
+ Browser.element
+ { init = init
+ , update = update
+ , view = view
+ , subscriptions = subscriptions
+ }
+
+
+-- TYPES
+
+
+type Tab
+ = ListensTab
+ | StatsTab
+
+
+type Period
+ = AllTime
+ | LastDays Int
+ | CustomRange String String
+
+
+type alias ActiveFilter =
+ { field : String
+ , value : String
+ }
+
+
+type alias Listen =
+ { trackName : Maybe String
+ , artistName : Maybe String
+ , releaseName : Maybe String
+ , listenedAt : Maybe Int
+ , genre : Maybe String
+ , releaseMbid : Maybe String
+ , caaReleaseMbid : Maybe String
+ }
+
+
+type alias StatsEntry =
+ { name : String
+ , count : Int
+ }
+
+
+type alias Stats =
+ { genres : List StatsEntry
+ , labels : List StatsEntry
+ , years : List StatsEntry
+ , artists : List StatsEntry
+ , tracks : List StatsEntry
+ }
+
+
+-- MODEL
+
+
+type alias Model =
+ { listens : List Listen
+ , stats : Maybe Stats
+ , lastCheck : Maybe Time.Posix
+ , error : Maybe String
+ , loading : Bool
+ , currentTime : Maybe Time.Posix
+ , failedCovers : Set String
+ , hoveredCover : Maybe Int
+ , expandedSections : Set String
+ , loadedSections : Set String
+ , offset : Int
+ , limit : Int
+ , activeTab : Tab
+ , activeFilter : Maybe ActiveFilter
+ , statsPeriod : Period
+ , customInput : String
+ , showCustomInput : Bool
+ , customError : Maybe String
+ }
+
+
+init : String -> ( Model, Cmd Msg )
+init searchString =
+ let
+ page =
+ parsePageParam searchString
+
+ offset =
+ max 0 ((page - 1) * 25)
+ in
+ ( { listens = []
+ , stats = Nothing
+ , lastCheck = Nothing
+ , error = Nothing
+ , loading = True
+ , currentTime = Nothing
+ , failedCovers = Set.empty
+ , hoveredCover = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , offset = offset
+ , limit = 25
+ , activeTab = ListensTab
+ , activeFilter = Nothing
+ , statsPeriod = AllTime
+ , customInput = ""
+ , showCustomInput = False
+ , customError = Nothing
+ }
+ , Cmd.batch
+ [ fetchListens 25 offset Nothing
+ , Task.perform GotTime Time.now
+ ]
+ )
+
+
+parsePageParam : String -> Int
+parsePageParam search =
+ let
+ s =
+ if String.startsWith "?" search then
+ String.dropLeft 1 search
+
+ else
+ search
+ in
+ s
+ |> String.split "&"
+ |> List.filterMap
+ (\pair ->
+ case String.split "=" pair of
+ [ "page", v ] ->
+ String.toInt v
+
+ _ ->
+ Nothing
+ )
+ |> List.head
+ |> Maybe.withDefault 1
+
+
+-- MSG
+
+
+type Msg
+ = GotListens (Result Http.Error (List Listen))
+ | GotStats (Result Http.Error Stats)
+ | GotSectionData String (Result Http.Error (List StatsEntry))
+ | Tick Time.Posix
+ | GotTime Time.Posix
+ | ImageError String
+ | NextPage
+ | PrevPage
+ | SwitchTab Tab
+ | SetStatsPeriod Period
+ | OpenCustomInput
+ | UpdateCustomInput String
+ | ApplyCustomPeriod
+ | FilterBy String String
+ | ClearFilter
+ | HoverCover Int
+ | UnhoverCover
+ | ExpandSection String
+ | ShowAllSection String
+ | CollapseSection String
+
+
+-- UPDATE
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+ case msg of
+ Tick time ->
+ if not model.loading then
+ ( { model | currentTime = Just time, loading = True }
+ , fetchListens model.limit model.offset model.activeFilter
+ )
+
+ else
+ ( { model | currentTime = Just time }, Cmd.none )
+
+ GotTime time ->
+ ( { model | lastCheck = Just time, currentTime = Just time }, Cmd.none )
+
+ GotListens result ->
+ let
+ newModel =
+ case result of
+ Err err ->
+ { model | loading = False, error = Just (httpErrorToString err) }
+
+ Ok listens ->
+ { model | loading = False, listens = listens, error = Nothing }
+ in
+ ( newModel, Task.perform GotTime Time.now )
+
+ GotStats result ->
+ case result of
+ Err err ->
+ ( { model | error = Just (httpErrorToString err) }, Cmd.none )
+
+ Ok stats ->
+ ( { model | stats = Just stats }, Cmd.none )
+
+ GotSectionData section result ->
+ case result of
+ Err err ->
+ ( { model | error = Just (httpErrorToString err) }, Cmd.none )
+
+ Ok entries ->
+ ( { model
+ | expandedSections = Set.insert section model.expandedSections
+ , loadedSections = Set.insert section model.loadedSections
+ , stats = Maybe.map (patchStatSection section entries) model.stats
+ }
+ , Cmd.none
+ )
+
+ ImageError url ->
+ ( { model | failedCovers = Set.insert url model.failedCovers }, Cmd.none )
+
+ NextPage ->
+ let
+ newOffset =
+ model.offset + model.limit
+
+ page =
+ newOffset // model.limit + 1
+ in
+ ( { model | offset = newOffset, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit newOffset model.activeFilter
+ , pushUrl ("?page=" ++ String.fromInt page)
+ ]
+ )
+
+ PrevPage ->
+ let
+ newOffset =
+ max 0 (model.offset - model.limit)
+
+ page =
+ newOffset // model.limit + 1
+ in
+ ( { model | offset = newOffset, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit newOffset model.activeFilter
+ , pushUrl ("?page=" ++ String.fromInt page)
+ ]
+ )
+
+ SwitchTab tab ->
+ ( { model | activeTab = tab }
+ , case tab of
+ StatsTab ->
+ if model.stats == Nothing then
+ fetchStats model.statsPeriod
+
+ else
+ Cmd.none
+
+ ListensTab ->
+ Cmd.none
+ )
+
+ SetStatsPeriod period ->
+ ( { model
+ | statsPeriod = period
+ , stats = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , showCustomInput = False
+ }
+ , fetchStats period
+ )
+
+ OpenCustomInput ->
+ let
+ prefill =
+ case model.statsPeriod of
+ CustomRange from to ->
+ from ++ " " ++ to
+
+ _ ->
+ model.customInput
+ in
+ ( { model | showCustomInput = True, customInput = prefill, customError = Nothing }
+ , Cmd.none
+ )
+
+ UpdateCustomInput str ->
+ ( { model | customInput = str, customError = Nothing }, Cmd.none )
+
+ ApplyCustomPeriod ->
+ let
+ parts =
+ model.customInput
+ |> String.split " "
+ |> List.filter (not << String.isEmpty)
+ in
+ case parts of
+ [ from, to ] ->
+ if String.length from /= 10 || String.length to /= 10 then
+ ( { model | customError = Just "Dates must be in YYYY-MM-DD format" }, Cmd.none )
+
+ else if from > to then
+ ( { model | customError = Just "'from' must be before 'to'" }, Cmd.none )
+
+ else
+ let
+ period =
+ CustomRange from to
+ in
+ ( { model
+ | statsPeriod = period
+ , stats = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , showCustomInput = False
+ , customError = Nothing
+ }
+ , fetchStats period
+ )
+
+ _ ->
+ ( { model | customError = Just "Enter two dates separated by a space" }, Cmd.none )
+
+ FilterBy field value ->
+ let
+ filter =
+ Just { field = field, value = value }
+ in
+ ( { model | activeFilter = filter, offset = 0, activeTab = ListensTab, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit 0 filter
+ , pushUrl "?page=1"
+ ]
+ )
+
+ ClearFilter ->
+ ( { model | activeFilter = Nothing, offset = 0, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit 0 Nothing
+ , pushUrl "?page=1"
+ ]
+ )
+
+ HoverCover idx ->
+ ( { model | hoveredCover = Just idx }, Cmd.none )
+
+ UnhoverCover ->
+ ( { model | hoveredCover = Nothing }, Cmd.none )
+
+ ExpandSection section ->
+ ( { model | expandedSections = Set.insert section model.expandedSections }, Cmd.none )
+
+ ShowAllSection section ->
+ ( model, fetchSectionData model.statsPeriod section )
+
+ CollapseSection section ->
+ ( { model
+ | expandedSections = Set.remove section model.expandedSections
+ , loadedSections = Set.remove section model.loadedSections
+ }
+ , Cmd.none
+ )
+
+
+patchStatSection : String -> List StatsEntry -> Stats -> Stats
+patchStatSection section entries stats =
+ case section of
+ "artist" ->
+ { stats | artists = entries }
+
+ "track" ->
+ { stats | tracks = entries }
+
+ "genre" ->
+ { stats | genres = entries }
+
+ "label" ->
+ { stats | labels = entries }
+
+ "year" ->
+ { stats | years = entries }
+
+ _ ->
+ stats
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions _ =
+ Time.every 30000 Tick
+
+
+-- HTTP
+
+
+fetchListens : Int -> Int -> Maybe ActiveFilter -> Cmd Msg
+fetchListens limit offset mFilter =
+ let
+ filterParams =
+ case mFilter of
+ Nothing ->
+ ""
+
+ Just { field, value } ->
+ "&filterField=" ++ field ++ "&filterValue=" ++ Url.percentEncode value
+
+ url =
+ "/proxy?limit=" ++ String.fromInt limit ++ "&offset=" ++ String.fromInt offset ++ filterParams
+ in
+ Http.get
+ { url = url
+ , expect = Http.expectJson GotListens listensDecoder
+ }
+
+
+fetchStats : Period -> Cmd Msg
+fetchStats period =
+ Http.get
+ { url = statsUrl period Nothing
+ , expect = Http.expectJson GotStats statsDecoder
+ }
+
+
+fetchSectionData : Period -> String -> Cmd Msg
+fetchSectionData period section =
+ Http.get
+ { url = statsUrl period (Just section)
+ , expect = Http.expectJson (GotSectionData section) (sectionEntriesDecoder section)
+ }
+
+
+statsUrl : Period -> Maybe String -> String
+statsUrl period mSection =
+ let
+ periodPart =
+ case period of
+ AllTime ->
+ ""
+
+ LastDays n ->
+ "period=" ++ String.fromInt n
+
+ CustomRange from to ->
+ "from=" ++ from ++ "&to=" ++ to
+
+ sectionPart =
+ case mSection of
+ Nothing ->
+ ""
+
+ Just sec ->
+ (if String.isEmpty periodPart then "" else "&") ++ "section=" ++ sec
+
+ query =
+ periodPart ++ sectionPart
+ in
+ "/stats" ++ (if String.isEmpty query then "" else "?" ++ query)
+
+
+httpErrorToString : Http.Error -> String
+httpErrorToString err =
+ case err of
+ Http.BadUrl url ->
+ "Bad URL: " ++ url
+
+ Http.Timeout ->
+ "Request timed out"
+
+ Http.NetworkError ->
+ "Network error"
+
+ Http.BadStatus status ->
+ "Server error: " ++ String.fromInt status
+
+ Http.BadBody body ->
+ "JSON decode error: " ++ body
+
+
+-- DECODERS
+
+
+listensDecoder : Decoder (List Listen)
+listensDecoder =
+ D.at [ "payload", "listens" ] (D.list listenDecoder)
+
+
+listenDecoder : Decoder Listen
+listenDecoder =
+ D.map2
+ (\meta listenedAt ->
+ { trackName = meta.trackName
+ , artistName = meta.artistName
+ , releaseName = meta.releaseName
+ , listenedAt = listenedAt
+ , genre = meta.genre
+ , releaseMbid = meta.releaseMbid
+ , caaReleaseMbid = meta.caaReleaseMbid
+ }
+ )
+ (D.field "track_metadata" trackMetaDecoder)
+ (D.maybe (D.field "listened_at" D.int))
+
+
+type alias TrackMeta =
+ { trackName : Maybe String
+ , artistName : Maybe String
+ , releaseName : Maybe String
+ , genre : Maybe String
+ , releaseMbid : Maybe String
+ , caaReleaseMbid : Maybe String
+ }
+
+
+trackMetaDecoder : Decoder TrackMeta
+trackMetaDecoder =
+ D.map6 TrackMeta
+ (D.maybe (D.field "track_name" D.string))
+ (D.maybe (D.field "artist_name" D.string))
+ (D.maybe (D.field "release_name" D.string))
+ (D.maybe (D.field "genre" D.string))
+ (D.maybe (D.at [ "mbid_mapping", "release_mbid" ] D.string))
+ (D.maybe (D.at [ "mbid_mapping", "caa_release_mbid" ] D.string))
+
+
+statsDecoder : Decoder Stats
+statsDecoder =
+ D.map5 Stats
+ (D.field "genres" (D.list entryDecoder))
+ (D.field "labels" (D.list entryDecoder))
+ (D.field "years" (D.list entryDecoder))
+ (D.field "artists" (D.list entryDecoder))
+ (D.field "tracks" (D.list entryDecoder))
+
+
+entryDecoder : Decoder StatsEntry
+entryDecoder =
+ D.map2 StatsEntry
+ (D.field "name" D.string)
+ (D.field "count" D.int)
+
+
+sectionEntriesDecoder : String -> Decoder (List StatsEntry)
+sectionEntriesDecoder section =
+ D.map
+ (\stats ->
+ case section of
+ "artist" ->
+ stats.artists
+
+ "track" ->
+ stats.tracks
+
+ "genre" ->
+ stats.genres
+
+ "label" ->
+ stats.labels
+
+ "year" ->
+ stats.years
+
+ _ ->
+ []
+ )
+ statsDecoder
+
+
+-- VIEW
+
+
+view : Model -> Html Msg
+view model =
+ div [ class "container" ]
+ [ h1 [] [ text "scrobbler" ]
+ , div [ class "tabs" ]
+ [ a
+ [ class ("tab-btn" ++ (if model.activeTab == ListensTab then " active" else ""))
+ , href "/"
+ ]
+ [ text "listens" ]
+ , button
+ [ class ("tab-btn" ++ (if model.activeTab == StatsTab then " active" else ""))
+ , onClick (SwitchTab StatsTab)
+ ]
+ [ text "stats" ]
+ ]
+ , case model.activeTab of
+ ListensTab ->
+ div []
+ [ case model.activeFilter of
+ Nothing ->
+ text ""
+
+ Just { field, value } ->
+ div [ class "filter-banner" ]
+ [ span [ class "filter-label" ]
+ [ text (field ++ ": ")
+ , strong [] [ text value ]
+ ]
+ , button [ class "filter-clear", onClick ClearFilter ]
+ [ text "✕ clear" ]
+ ]
+ , renderContent model
+ , div [ class "pagination" ]
+ [ button
+ [ class "page-btn"
+ , disabled (model.offset == 0 || model.loading)
+ , onClick PrevPage
+ ]
+ [ text "Previous" ]
+ , div [ class "page-indicator" ]
+ [ text ("Page " ++ String.fromInt (model.offset // model.limit + 1)) ]
+ , button
+ [ class "page-btn"
+ , disabled (List.length model.listens < model.limit || model.loading)
+ , onClick NextPage
+ ]
+ [ text "Next" ]
+ ]
+ ]
+
+ StatsTab ->
+ div []
+ [ renderPeriodSelector model.statsPeriod model.showCustomInput model.customInput model.customError
+ , renderStatsView model.expandedSections model.loadedSections model.stats
+ ]
+ , div [ Attr.id "footer", class "small" ]
+ [ span [] [ text (lastCheckText model.currentTime model.lastCheck) ] ]
+ ]
+
+
+renderContent : Model -> Html Msg
+renderContent model =
+ if model.loading && List.isEmpty model.listens then
+ ul [] [ li [ class "loading" ] [ text "Loading recent tracks..." ] ]
+
+ else
+ case model.error of
+ Just err ->
+ ul [] [ li [ class "error" ] [ text err ] ]
+
+ Nothing ->
+ ul [ Attr.id "tracks-container" ]
+ (List.indexedMap
+ (\idx listen ->
+ renderListen model.currentTime model.failedCovers model.hoveredCover idx listen
+ )
+ model.listens
+ )
+
+
+renderListen : Maybe Time.Posix -> Set String -> Maybe Int -> Int -> Listen -> Html Msg
+renderListen currentTime failedCovers hoveredCover idx listen =
+ let
+ artist =
+ Maybe.withDefault "" listen.artistName
+
+ release =
+ Maybe.withDefault "" listen.releaseName
+
+ mbid =
+ case listen.caaReleaseMbid of
+ Just m ->
+ Just m
+
+ Nothing ->
+ listen.releaseMbid
+
+ coverUrl =
+ "/cover?artist="
+ ++ Url.percentEncode artist
+ ++ "&release="
+ ++ Url.percentEncode release
+ ++ (case mbid of
+ Just m ->
+ "&mbid=" ++ m
+
+ Nothing ->
+ ""
+ )
+
+ isZoomed =
+ hoveredCover == Just idx
+ in
+ li [ class "success" ]
+ [ div [ class "track-info" ]
+ [ div [ class "track-name" ]
+ [ text (Maybe.withDefault "Unknown Track" listen.trackName) ]
+ , div [ class "track-artist" ] [ text artist ]
+ , div [ class "track-time" ]
+ [ span []
+ [ a
+ [ href ("https://www.discogs.com/search/?q=" ++ Url.percentEncode (artist ++ " " ++ release) ++ "&type=release")
+ , target "_blank"
+ , class "album-link"
+ ]
+ [ text release ]
+ , text (" • " ++ timeAgo currentTime listen.listenedAt)
+ ]
+ ]
+ ]
+ , div [ class "cover-wrapper" ]
+ [ if Set.member coverUrl failedCovers then
+ text ""
+
+ else
+ img
+ [ class ("track-cover" ++ (if isZoomed then " zoomed" else ""))
+ , src coverUrl
+ , Attr.alt release
+ , on "error" (D.succeed (ImageError coverUrl))
+ , onClick
+ (if isZoomed then
+ UnhoverCover
+
+ else
+ HoverCover idx
+ )
+ ]
+ []
+ , case listen.genre of
+ Just g ->
+ div [ class "genre-tag" ] [ text g ]
+
+ Nothing ->
+ text ""
+ ]
+ ]
+
+
+renderStatsView : Set String -> Set String -> Maybe Stats -> Html Msg
+renderStatsView expandedSections loadedSections mStats =
+ case mStats of
+ Nothing ->
+ div [ class "loading" ] [ text "Loading stats..." ]
+
+ Just stats ->
+ div []
+ [ renderStatSection expandedSections loadedSections (Just "artist") "top artists" stats.artists
+ , renderStatSection expandedSections loadedSections Nothing "top tracks" stats.tracks
+ , renderStatSection expandedSections loadedSections (Just "genre") "genres" stats.genres
+ , renderStatSection expandedSections loadedSections (Just "label") "labels" stats.labels
+ , renderStatSection expandedSections loadedSections (Just "year") "years" stats.years
+ ]
+
+
+renderStatSection : Set String -> Set String -> Maybe String -> String -> List StatsEntry -> Html Msg
+renderStatSection expandedSections loadedSections mField title entries =
+ let
+ sectionKey =
+ Maybe.withDefault title mField
+
+ expanded =
+ Set.member sectionKey expandedSections
+
+ loaded =
+ Set.member sectionKey loadedSections
+
+ visible =
+ if loaded then
+ entries
+
+ else if expanded then
+ List.take 50 entries
+
+ else
+ List.take 10 entries
+
+ maxCount =
+ entries
+ |> List.map .count
+ |> List.maximum
+ |> Maybe.withDefault 1
+
+ n =
+ List.length entries
+
+ footer =
+ if loaded then
+ if n > 10 then
+ button [ class "show-all-btn", onClick (CollapseSection sectionKey) ] [ text "show less" ]
+
+ else
+ text ""
+
+ else if expanded then
+ if n >= 50 then
+ span []
+ [ button [ class "show-all-btn", onClick (ShowAllSection sectionKey) ] [ text "show all" ]
+ , text " · "
+ , button [ class "show-all-btn", onClick (CollapseSection sectionKey) ] [ text "show less" ]
+ ]
+
+ else
+ button [ class "show-all-btn", onClick (CollapseSection sectionKey) ] [ text "show less" ]
+
+ else if n > 10 then
+ button [ class "show-all-btn", onClick (ExpandSection sectionKey) ] [ text "show more" ]
+
+ else
+ text ""
+ in
+ div [ class "stats-section" ]
+ [ h2 [] [ text title ]
+ , if List.isEmpty entries then
+ div [ class "stats-empty" ] [ text "no data yet — enrichment in progress" ]
+
+ else
+ ul [] (List.map (renderStatEntry maxCount mField) visible)
+ , footer
+ ]
+
+
+renderStatEntry : Int -> Maybe String -> StatsEntry -> Html Msg
+renderStatEntry maxCount mField entry =
+ let
+ barPct =
+ entry.count * 100 // maxCount
+
+ rowAttrs =
+ case mField of
+ Just field ->
+ [ class "stat-row clickable", onClick (FilterBy field entry.name) ]
+
+ Nothing ->
+ [ class "stat-row" ]
+ in
+ li rowAttrs
+ [ div [ class "stat-bar", style "width" (String.fromInt barPct ++ "%") ] []
+ , span [ class "stat-name" ] [ text entry.name ]
+ , span [ class "stat-count" ] [ text (String.fromInt entry.count) ]
+ ]
+
+
+renderPeriodSelector : Period -> Bool -> String -> Maybe String -> Html Msg
+renderPeriodSelector current showInput customVal mError =
+ let
+ isCustom =
+ case current of
+ CustomRange _ _ ->
+ True
+
+ _ ->
+ False
+
+ namedBtn target label =
+ button
+ [ class ("period-btn" ++ (if current == target then " active" else ""))
+ , onClick (SetStatsPeriod target)
+ ]
+ [ text label ]
+
+ customBtn =
+ button
+ [ class ("period-btn" ++ (if isCustom then " active" else ""))
+ , onClick OpenCustomInput
+ ]
+ [ text "custom" ]
+
+ daysBtn n =
+ let
+ label =
+ case n of
+ 7 ->
+ "1w"
+
+ 14 ->
+ "2w"
+
+ 30 ->
+ "1m"
+
+ 90 ->
+ "3m"
+
+ 180 ->
+ "6m"
+
+ 365 ->
+ "1y"
+
+ _ ->
+ String.fromInt n ++ "d"
+ in
+ button
+ [ class ("period-btn" ++ (if current == LastDays n then " active" else ""))
+ , onClick (SetStatsPeriod (LastDays n))
+ ]
+ [ text label ]
+ in
+ div []
+ [ div [ class "period-selector" ]
+ ([ namedBtn AllTime "all time", customBtn ]
+ ++ List.map daysBtn [ 7, 14, 30, 90, 180, 365 ]
+ )
+ , if showInput || isCustom then
+ div []
+ [ div [ class "custom-range" ]
+ [ input
+ [ type_ "text"
+ , class ("custom-range-input" ++ (if mError /= Nothing then " error" else ""))
+ , placeholder "2023-01-01 2026-01-01"
+ , value customVal
+ , onInput UpdateCustomInput
+ ]
+ []
+ , button [ class "period-btn", onClick ApplyCustomPeriod ]
+ [ text "apply" ]
+ ]
+ , case mError of
+ Just err ->
+ div [ class "custom-range-error" ] [ text err ]
+
+ Nothing ->
+ text ""
+ ]
+
+ else
+ text ""
+ ]
+
+
+-- HELPERS
+
+
+timeAgo : Maybe Time.Posix -> Maybe Int -> String
+timeAgo mNow mTimestamp =
+ case ( mNow, mTimestamp ) of
+ ( Just now, Just ts ) ->
+ let
+ nowSecs =
+ Time.posixToMillis now // 1000
+
+ diff =
+ nowSecs - ts
+ in
+ if diff < 60 then
+ "just now"
+
+ else if diff < 3600 then
+ let
+ mins =
+ diff // 60
+ in
+ String.fromInt mins ++ " minute" ++ (if mins > 1 then "s" else "") ++ " ago"
+
+ else if diff < 86400 then
+ let
+ hours =
+ diff // 3600
+ in
+ String.fromInt hours ++ " hour" ++ (if hours > 1 then "s" else "") ++ " ago"
+
+ else
+ let
+ days =
+ diff // 86400
+ in
+ String.fromInt days ++ " day" ++ (if days > 1 then "s" else "") ++ " ago"
+
+ _ ->
+ "unknown time"
+
+
+lastCheckText : Maybe Time.Posix -> Maybe Time.Posix -> String
+lastCheckText mCurrent mLastCheck =
+ case ( mCurrent, mLastCheck ) of
+ ( Just current, Just lastCheck ) ->
+ let
+ diff =
+ (Time.posixToMillis current - Time.posixToMillis lastCheck) // 1000
+ in
+ if diff < 5 then
+ "just updated"
+
+ else
+ "last checked " ++ String.fromInt diff ++ "s ago"
+
+ _ ->
+ ""
diff --git a/src/Client.js b/src/Client.js
@@ -1,8 +0,0 @@
-export const extractParam = (key) => (search) => {
- const params = new URLSearchParams(search);
- return params.get(key);
-};
-
-export const formatRFC3339 = (instant) => {
- return new Date(instant).toISOString();
-};
diff --git a/src/Client.purs b/src/Client.purs
@@ -1,583 +0,0 @@
-module Client where
-
-import Prelude
-
-import Affjax.Web as AX
-import Affjax.ResponseFormat as ResponseFormat
-import Data.Argonaut (decodeJson)
-import Data.Array (mapWithIndex, length, take, filter)
-import Data.String (Pattern(..))
-import Data.String as Str
-import Data.Either (Either(..))
-import Data.Int (floor, fromString, toNumber)
-import Data.Foldable (maximum)
-import Data.Maybe (Maybe(..), fromMaybe)
-import Effect (Effect)
-import Effect.Aff (Aff, delay)
-import Effect.Aff.Class (class MonadAff)
-import Effect.Class (liftEffect)
-import Effect.Now (now)
-import Control.Monad.Rec.Class (forever)
-import Halogen as H
-import Halogen.Aff as HA
-import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Halogen.VDom.Driver (runUI)
-import JSURI (encodeURIComponent)
-import Web.DOM.ParentNode (QuerySelector(..))
-import Types (Listen(..), ListenBrainzResponse(..), TrackMetadata(..), Payload(..), MbidMapping(..), Stats(..), StatsEntry(..))
-import Data.Time.Duration (Milliseconds(..))
-import Data.DateTime.Instant (Instant, unInstant)
-import Data.Set (Set)
-import Data.Set as Set
-import Web.HTML (window)
-import Web.HTML.Window (location, history)
-import Web.HTML.Location (search)
-import Web.HTML.History (pushState, DocumentTitle(..), URL(..))
-import Foreign (unsafeToForeign)
-import Data.Nullable (Nullable, toMaybe)
-
-data Tab = ListensTab | StatsTab
-
-derive instance eqTab :: Eq Tab
-
-data Period = AllTime | LastDays Int | CustomRange String String
-
-derive instance eqPeriod :: Eq Period
-
-type ActiveFilter = { field :: String, value :: String }
-
-type State =
- { listens :: Array Listen
- , stats :: Maybe Stats
- , lastCheck :: Maybe String
- , error :: Maybe String
- , loading :: Boolean
- , currentTime :: Maybe Milliseconds
- , failedCovers :: Set String
- , hoveredCover :: Maybe Int
- , expandedSections :: Set String
- , loadedSections :: Set String
- , offset :: Int
- , limit :: Int
- , activeTab :: Tab
- , activeFilter :: Maybe ActiveFilter
- , statsPeriod :: Period
- , customInput :: String
- , showCustomInput :: Boolean
- , customError :: Maybe String
- }
-
-data Action
- = Initialize
- | Refresh
- | ReceiveResponse (Either String (Array Listen))
- | ReceiveStats (Either String Stats)
- | ImageError String
- | NextPage
- | PrevPage
- | SwitchTab Tab
- | SetStatsPeriod Period
- | OpenCustomInput
- | UpdateCustomInput String
- | ApplyCustomPeriod
- | FilterBy String String
- | ClearFilter
- | HoverCover Int
- | UnhoverCover
- | ExpandSection String
- | ShowAllSection String
- | CollapseSection String
- | ReceiveSectionData String (Either String (Array StatsEntry))
-
-component :: forall query input output m. MonadAff m => H.Component query input output m
-component =
- H.mkComponent
- { initialState
- , render
- , eval: H.mkEval $ H.defaultEval
- { handleAction = handleAction
- , initialize = Just Initialize
- }
- }
- where
- initialState _ =
- { listens: []
- , stats: Nothing
- , lastCheck: Nothing
- , error: Nothing
- , loading: true
- , currentTime: Nothing
- , failedCovers: Set.empty
- , hoveredCover: Nothing
- , expandedSections: Set.empty
- , loadedSections: Set.empty
- , offset: 0
- , limit: 25
- , activeTab: ListensTab
- , activeFilter: Nothing
- , statsPeriod: AllTime
- , customInput: ""
- , showCustomInput: false
- , customError: Nothing
- }
-
- render state =
- HH.div
- [ HP.class_ (H.ClassName "container") ]
- [ HH.h1_ [ HH.text "scrobbler" ]
- , HH.div
- [ HP.class_ (H.ClassName "tabs") ]
- [ HH.a
- [ HP.class_ (H.ClassName $ "tab-btn" <> if state.activeTab == ListensTab then " active" else "")
- , HP.href "/"
- ]
- [ HH.text "listens" ]
- , HH.button
- [ HP.class_ (H.ClassName $ "tab-btn" <> if state.activeTab == StatsTab then " active" else "")
- , HE.onClick \_ -> SwitchTab StatsTab
- ]
- [ HH.text "stats" ]
- ]
- , case state.activeTab of
- ListensTab ->
- HH.div_
- [ case state.activeFilter of
- Nothing -> HH.text ""
- Just { field, value } ->
- HH.div [ HP.class_ (H.ClassName "filter-banner") ]
- [ HH.span [ HP.class_ (H.ClassName "filter-label") ]
- [ HH.text $ field <> ": "
- , HH.strong_ [ HH.text value ]
- ]
- , HH.button
- [ HP.class_ (H.ClassName "filter-clear")
- , HE.onClick \_ -> ClearFilter
- ]
- [ HH.text "✕ clear" ]
- ]
- , renderContent state
- , HH.div
- [ HP.class_ (H.ClassName "pagination") ]
- [ HH.button
- [ HP.class_ (H.ClassName "page-btn")
- , HP.disabled (state.offset == 0 || state.loading)
- , HE.onClick \_ -> PrevPage
- ]
- [ HH.text "Previous" ]
- , HH.div [ HP.class_ (H.ClassName "page-indicator") ] [ HH.text $ "Page " <> show (state.offset / state.limit + 1) ]
- , HH.button
- [ HP.class_ (H.ClassName "page-btn")
- , HP.disabled (length state.listens < state.limit || state.loading)
- , HE.onClick \_ -> NextPage
- ]
- [ HH.text "Next" ]
- ]
- ]
- StatsTab ->
- HH.div_
- [ renderPeriodSelector state.statsPeriod state.showCustomInput state.customInput state.customError
- , renderStatsView state.expandedSections state.loadedSections state.stats
- ]
- , HH.div
- [ HP.id "footer"
- , HP.class_ (H.ClassName "small")
- ]
- [ HH.span_ [ HH.text $ fromMaybe "" state.lastCheck ]
- ]
- ]
-
- renderStatsView _ _ Nothing =
- HH.div [ HP.class_ (H.ClassName "loading") ] [ HH.text "Loading stats..." ]
- renderStatsView expandedSections loadedSections (Just (Stats { genres, labels, years, artists, tracks })) =
- HH.div_
- [ renderStatSection expandedSections loadedSections (Just "artist") "top artists" artists
- , renderStatSection expandedSections loadedSections Nothing "top tracks" tracks
- , renderStatSection expandedSections loadedSections (Just "genre") "genres" genres
- , renderStatSection expandedSections loadedSections (Just "label") "labels" labels
- , renderStatSection expandedSections loadedSections (Just "year") "years" years
- ]
-
- renderStatSection expandedSections loadedSections mField title entries =
- let
- sectionKey = fromMaybe title mField
- maxCount = fromMaybe 1 (maximum (map (\(StatsEntry e) -> e.count) entries))
- expanded = Set.member sectionKey expandedSections
- loaded = Set.member sectionKey loadedSections
- visible = if loaded then entries else if expanded then take 50 entries else take 10 entries
- btn action label =
- HH.button
- [ HP.class_ (H.ClassName "show-all-btn"), HE.onClick \_ -> action ]
- [ HH.text label ]
- footer =
- if loaded then
- if length entries > 10 then btn (CollapseSection sectionKey) "show less" else HH.text ""
- else if expanded then
- -- we have up to 50; show "show all" only if there might be more
- if length entries >= 50 then HH.span_ [ btn (ShowAllSection sectionKey) "show all", HH.text " · ", btn (CollapseSection sectionKey) "show less" ]
- else btn (CollapseSection sectionKey) "show less"
- else if length entries > 10 then btn (ExpandSection sectionKey) "show more"
- else HH.text ""
- in
- HH.div [ HP.class_ (H.ClassName "stats-section") ]
- [ HH.h2_ [ HH.text title ]
- , if entries == [] then
- HH.div [ HP.class_ (H.ClassName "stats-empty") ] [ HH.text "no data yet — enrichment in progress" ]
- else
- HH.ul_ (map (renderStatEntry maxCount mField) visible)
- , footer
- ]
-
- renderStatEntry maxCount mField (StatsEntry { name, count }) =
- let
- barPct = floor (toNumber count * 100.0 / toNumber maxCount)
- clickProps = case mField of
- Just field -> [ HE.onClick \_ -> FilterBy field name ]
- Nothing -> []
- in
- HH.li
- ([ HP.class_ (H.ClassName $ "stat-row" <> if mField /= Nothing then " clickable" else "") ] <> clickProps)
- [ HH.div
- [ HP.class_ (H.ClassName "stat-bar")
- , HP.style $ "width: " <> show barPct <> "%"
- ]
- []
- , HH.span [ HP.class_ (H.ClassName "stat-name") ] [ HH.text name ]
- , HH.span [ HP.class_ (H.ClassName "stat-count") ] [ HH.text $ show count ]
- ]
-
- renderPeriodSelector current showInput customVal mError =
- HH.div_
- [ HH.div
- [ HP.class_ (H.ClassName "period-selector") ]
- ( [ namedBtn AllTime "all time", customBtn ]
- <> map daysBtn [ 7, 14, 30, 90, 180, 365 ]
- )
- , if showInput || isCustom then
- HH.div_
- [ HH.div
- [ HP.class_ (H.ClassName "custom-range") ]
- [ HH.input
- [ HP.type_ HP.InputText
- , HP.class_ (H.ClassName $ "custom-range-input" <> if mError /= Nothing then " error" else "")
- , HP.placeholder "2023-01-01 2026-01-01"
- , HP.value customVal
- , HE.onValueInput UpdateCustomInput
- ]
- , HH.button
- [ HP.class_ (H.ClassName "period-btn")
- , HE.onClick \_ -> ApplyCustomPeriod
- ]
- [ HH.text "apply" ]
- ]
- , case mError of
- Just err -> HH.div [ HP.class_ (H.ClassName "custom-range-error") ] [ HH.text err ]
- Nothing -> HH.text ""
- ]
- else HH.text ""
- ]
- where
- isCustom = case current of
- CustomRange _ _ -> true
- _ -> false
- namedBtn target label =
- HH.button
- [ HP.class_ (H.ClassName $ "period-btn" <> if current == target then " active" else "")
- , HE.onClick \_ -> SetStatsPeriod target
- ]
- [ HH.text label ]
- customBtn =
- HH.button
- [ HP.class_ (H.ClassName $ "period-btn" <> if isCustom then " active" else "")
- , HE.onClick \_ -> OpenCustomInput
- ]
- [ HH.text "custom" ]
- daysBtn n =
- HH.button
- [ HP.class_ (H.ClassName $ "period-btn" <> if current == LastDays n then " active" else "")
- , HE.onClick \_ -> SetStatsPeriod (LastDays n)
- ]
- [ HH.text $ case n of
- 7 -> "1w"
- 14 -> "2w"
- 30 -> "1m"
- 90 -> "3m"
- 180 -> "6m"
- 365 -> "1y"
- _ -> show n <> "d"
- ]
-
- renderContent state
- | state.loading && state.listens == [] =
- HH.ul_ [ HH.li [ HP.class_ (H.ClassName "loading") ] [ HH.text "Loading recent tracks..." ] ]
- | Just err <- state.error =
- HH.ul_ [ HH.li [ HP.class_ (H.ClassName "error") ] [ HH.text err ] ]
- | otherwise =
- HH.ul [ HP.id "tracks-container" ]
- (mapWithIndex (renderListen state.currentTime state.failedCovers state.hoveredCover) state.listens)
-
- renderListen currentTime failedCovers hoveredCover idx (Listen { trackMetadata: TrackMetadata track, listenedAt }) =
- let
- release = fromMaybe "" track.releaseName
- artist = fromMaybe "" track.artistName
-
- mbid = case track.mbidMapping of
- Just (MbidMapping { caaReleaseMbid: Just m }) -> Just m
- Just (MbidMapping { releaseMbid: Just m }) -> Just m
- _ -> Nothing
-
- coverUrl = "/cover?artist=" <> (fromMaybe "" $ encodeURIComponent artist)
- <> "&release="
- <> (fromMaybe "" $ encodeURIComponent release)
- <>
- ( case mbid of
- Just m -> "&mbid=" <> m
- Nothing -> ""
- )
- in
- HH.li
- [ HP.class_ (H.ClassName "success") ]
- [ HH.div
- [ HP.class_ (H.ClassName "track-info") ]
- [ HH.div
- [ HP.class_ (H.ClassName "track-name") ]
- [ HH.text $ fromMaybe "Unknown Track" track.trackName ]
- , HH.div
- [ HP.class_ (H.ClassName "track-artist") ]
- [ HH.text artist ]
- , HH.div
- [ HP.class_ (H.ClassName "track-time") ]
- [ let
- query = fromMaybe "" $ encodeURIComponent (artist <> " " <> release)
- in
- HH.span_
- [ HH.a
- [ HP.href $ "https://www.discogs.com/search/?q=" <> query <> "&type=release"
- , HP.target "_blank"
- , HP.class_ (H.ClassName "album-link")
- ]
- [ HH.text release ]
- , HH.text $ " • " <> (fromMaybe "unknown time" $ formatTimeAgo currentTime listenedAt)
- ]
- ]
- ]
- , HH.div [ HP.class_ (H.ClassName "cover-wrapper") ]
- [ if Set.member coverUrl failedCovers then HH.text ""
- else HH.img
- [ HP.class_ (H.ClassName $ "track-cover" <> if hoveredCover == Just idx then " zoomed" else "")
- , HP.src coverUrl
- , HP.alt release
- , HE.onError \_ -> ImageError coverUrl
- , HE.onClick \_ -> if hoveredCover == Just idx then UnhoverCover else HoverCover idx
- ]
- , case track.genre of
- Just g -> HH.div [ HP.class_ (H.ClassName "genre-tag") ] [ HH.text g ]
- Nothing -> HH.text ""
- ]
- ]
-
- handleAction = case _ of
- Initialize -> do
- w <- liftEffect window
- loc <- liftEffect $ location w
- qs <- liftEffect $ search loc
- let pageParam = toMaybe $ extractParam "page" qs
- let initialPage = fromMaybe 1 (pageParam >>= fromString)
- let initialOffset = max 0 ((initialPage - 1) * 25)
-
- H.modify_ _ { offset = initialOffset }
-
- void $ H.fork $ forever (H.liftAff (delay (Milliseconds 30000.0)) *> handleAction Refresh)
- handleAction Refresh
- Refresh -> do
- state <- H.get
- H.modify_ _ { loading = true, error = Nothing }
- response <- H.liftAff $ fetchListens state.limit state.offset state.activeFilter
- handleAction (ReceiveResponse response)
- ReceiveResponse result -> do
- nowInstant <- liftEffect now
- let nowMs = unInstant nowInstant
- let nowStr = formatRFC3339 nowInstant
- case result of
- Left err -> H.modify_ _ { loading = false, error = Just err, lastCheck = Just nowStr, currentTime = Just nowMs }
- Right listens -> H.modify_ _ { loading = false, listens = listens, lastCheck = Just nowStr, currentTime = Just nowMs }
- ReceiveStats result -> case result of
- Left err -> H.modify_ _ { error = Just err }
- Right stats -> H.modify_ _ { stats = Just stats }
- FilterBy field value -> do
- H.modify_ _ { activeFilter = Just { field, value }, offset = 0, activeTab = ListensTab }
- updateUrl
- handleAction Refresh
- ClearFilter -> do
- H.modify_ _ { activeFilter = Nothing, offset = 0 }
- updateUrl
- handleAction Refresh
- SwitchTab tab -> do
- H.modify_ _ { activeTab = tab }
- case tab of
- StatsTab -> do
- state <- H.get
- when (state.stats == Nothing) do
- response <- H.liftAff $ fetchStats state.statsPeriod
- handleAction (ReceiveStats response)
- ListensTab -> pure unit
- SetStatsPeriod period -> do
- H.modify_ _ { statsPeriod = period, stats = Nothing, expandedSections = Set.empty, loadedSections = Set.empty, showCustomInput = false }
- response <- H.liftAff $ fetchStats period
- handleAction (ReceiveStats response)
- OpenCustomInput -> do
- state <- H.get
- let
- prefill = case state.statsPeriod of
- CustomRange from to -> from <> " " <> to
- _ -> state.customInput
- H.modify_ _ { showCustomInput = true, customInput = prefill, customError = Nothing }
- UpdateCustomInput str -> H.modify_ _ { customInput = str, customError = Nothing }
- ApplyCustomPeriod -> do
- state <- H.get
- let parts = filter (_ /= "") (Str.split (Pattern " ") state.customInput)
- case parts of
- [ from, to ]
- | Str.length from /= 10 || Str.length to /= 10 ->
- H.modify_ _ { customError = Just "Dates must be in YYYY-MM-DD format" }
- | from > to ->
- H.modify_ _ { customError = Just "'from' must be before 'to'" }
- | otherwise -> do
- let period = CustomRange from to
- H.modify_ _ { statsPeriod = period, stats = Nothing, expandedSections = Set.empty, loadedSections = Set.empty, showCustomInput = false, customError = Nothing }
- response <- H.liftAff $ fetchStats period
- handleAction (ReceiveStats response)
- _ -> H.modify_ _ { customError = Just "Enter two dates separated by a space" }
- ImageError url -> do
- H.modify_ \state -> state { failedCovers = Set.insert url state.failedCovers }
- NextPage -> do
- H.modify_ \state -> state { offset = state.offset + state.limit }
- updateUrl
- handleAction Refresh
- PrevPage -> do
- H.modify_ \state -> state { offset = max 0 (state.offset - state.limit) }
- updateUrl
- handleAction Refresh
- HoverCover url -> do
- H.modify_ _ { hoveredCover = Just url }
- UnhoverCover -> do
- H.modify_ _ { hoveredCover = Nothing }
- ExpandSection section ->
- H.modify_ \s -> s { expandedSections = Set.insert section s.expandedSections }
- ShowAllSection section -> do
- state <- H.get
- response <- H.liftAff $ fetchSectionData state.statsPeriod section
- handleAction (ReceiveSectionData section response)
-
- CollapseSection section ->
- H.modify_ \s -> s
- { expandedSections = Set.delete section s.expandedSections
- , loadedSections = Set.delete section s.loadedSections
- }
- ReceiveSectionData section result -> case result of
- Left err -> H.modify_ _ { error = Just err }
- Right entries -> H.modify_ \s -> s
- { expandedSections = Set.insert section s.expandedSections
- , loadedSections = Set.insert section s.loadedSections
- , stats = map (updateStatSection section entries) s.stats
- }
-
- updateUrl = do
- state <- H.get
- let page = (state.offset / state.limit) + 1
- liftEffect do
- w <- window
- h <- history w
- pushState (unsafeToForeign {}) (DocumentTitle "") (URL $ "?page=" <> show page) h
-
- fetchListens :: Int -> Int -> Maybe ActiveFilter -> Aff (Either String (Array Listen))
- fetchListens limit offset mFilter = do
- let
- filterParams = case mFilter of
- Nothing -> ""
- Just { field, value } -> "&filterField=" <> field <> "&filterValue=" <> (fromMaybe value (encodeURIComponent value))
- let url = "/proxy?limit=" <> show limit <> "&offset=" <> show offset <> filterParams
- res <- AX.get ResponseFormat.json url
- case res of
- Left err -> pure $ Left $ "Network error: " <> AX.printError err
- Right response ->
- case decodeJson response.body of
- Left err -> pure $ Left $ "JSON decode error: " <> show err
- Right (ListenBrainzResponse { payload: Payload { listens } }) -> pure $ Right listens
-
- updateStatSection section entries (Stats s) = Stats $ case section of
- "artist" -> s { artists = entries }
- "track" -> s { tracks = entries }
- "genre" -> s { genres = entries }
- "label" -> s { labels = entries }
- "year" -> s { years = entries }
- _ -> s
-
- statsUrl :: Period -> Maybe String -> String
- statsUrl period mSection =
- "/stats" <> case query of
- "" -> ""
- q -> "?" <> q
- where
- periodPart = case period of
- AllTime -> ""
- LastDays n -> "period=" <> show n
- CustomRange from to -> "from=" <> from <> "&to=" <> to
- sectionPart = case mSection of
- Nothing -> ""
- Just sec -> (if periodPart /= "" then "&" else "") <> "section=" <> sec
- query = periodPart <> sectionPart
-
- fetchSectionData :: Period -> String -> Aff (Either String (Array StatsEntry))
- fetchSectionData period section = do
- res <- AX.get ResponseFormat.json (statsUrl period (Just section))
- case res of
- Left err -> pure $ Left $ "Network error: " <> AX.printError err
- Right response ->
- case decodeJson response.body of
- Left err -> pure $ Left $ "JSON decode error: " <> show err
- Right (Stats s) -> pure $ Right $ case section of
- "artist" -> s.artists
- "track" -> s.tracks
- "genre" -> s.genres
- "label" -> s.labels
- "year" -> s.years
- _ -> []
-
- fetchStats :: Period -> Aff (Either String Stats)
- fetchStats period = do
- res <- AX.get ResponseFormat.json (statsUrl period Nothing)
- case res of
- Left err -> pure $ Left $ "Network error: " <> AX.printError err
- Right response ->
- case decodeJson response.body of
- Left err -> pure $ Left $ "JSON decode error: " <> show err
- Right stats -> pure $ Right stats
-
- formatTimeAgo :: Maybe Milliseconds -> Maybe Int -> Maybe String
- formatTimeAgo Nothing _ = Nothing
- formatTimeAgo _ Nothing = Nothing
- formatTimeAgo (Just (Milliseconds nowMs)) (Just timestamp) =
- let
- nowSecs = floor (nowMs / 1000.0)
- diff = nowSecs - timestamp
- in
- Just $
- if diff < 60 then "just now"
- else if diff < 3600 then
- let mins = diff / 60 in show mins <> " minute" <> (if mins > 1 then "s" else "") <> " ago"
- else if diff < 86400 then
- let hours = diff / 3600 in show hours <> " hour" <> (if hours > 1 then "s" else "") <> " ago"
- else
- let days = diff / 86400 in show days <> " day" <> (if days > 1 then "s" else "") <> " ago"
-
-main :: Effect Unit
-main = HA.runHalogenAff do
- maybeApp <- HA.selectElement (QuerySelector "#app")
- case maybeApp of
- Nothing -> HA.awaitBody >>= runUI component unit
- Just app -> runUI component unit app
-
-foreign import extractParam :: String -> String -> Nullable String
-foreign import formatRFC3339 :: Instant -> String
diff --git a/src/Main.purs b/src/Main.purs
@@ -760,6 +760,15 @@ indexHtml =
<body>
<div id="app"></div>
<script src="/client.js"></script>
+ <script>
+ var app = Elm.Client.init({
+ node: document.getElementById('app'),
+ flags: window.location.search
+ });
+ app.ports.pushUrl.subscribe(function(url) {
+ history.pushState({}, '', url);
+ });
+ </script>
</body>
</html>"""
