commit d01bb0b28dc69f2eac9d7733fdd7002575b6e420
parent 3ab2cc87e80dbabb273e984b071a9f31e84a9314
Author: mtmn <miro@haravara.org>
Date: Wed, 22 Apr 2026 20:33:09 +0200
feat: convert to avif; decouple Client.elm
Diffstat:
13 files changed, 2153 insertions(+), 1427 deletions(-)
diff --git a/package-lock.json b/package-lock.json
@@ -11,7 +11,8 @@
"@aws-sdk/client-s3": "^3.1029.0",
"dotenv": "^17.4.1",
"duckdb": "^1.4.4",
- "prom-client": "^15.1.3"
+ "prom-client": "^15.1.3",
+ "sharp": "^0.34.5"
},
"devDependencies": {
"elm": "^0.19.1",
@@ -876,6 +877,16 @@
"node": ">=18.0.0"
}
},
+ "node_modules/@emnapi/runtime": {
+ "version": "1.10.0",
+ "resolved": "https://registry.npmjs.org/@emnapi/runtime/-/runtime-1.10.0.tgz",
+ "integrity": "sha512-ewvYlk86xUoGI0zQRNq/mC+16R1QeDlKQy21Ki3oSYXNgLb45GV1P6A0M+/s6nyCuNDqe5VpaY84BzXGwVbwFA==",
+ "license": "MIT",
+ "optional": true,
+ "dependencies": {
+ "tslib": "^2.4.0"
+ }
+ },
"node_modules/@esbuild/aix-ppc64": {
"version": "0.28.0",
"resolved": "https://registry.npmjs.org/@esbuild/aix-ppc64/-/aix-ppc64-0.28.0.tgz",
@@ -1324,6 +1335,471 @@
"integrity": "sha512-k2Ty1JcVojjJFwrg/ThKi2ujJ7XNLYaFGNB/bWT9wGR+oSMJHMa5w+CUq6p/pVrKeNNgA7pCqEcjSnHVoqJQFw==",
"license": "MIT"
},
+ "node_modules/@img/colour": {
+ "version": "1.1.0",
+ "resolved": "https://registry.npmjs.org/@img/colour/-/colour-1.1.0.tgz",
+ "integrity": "sha512-Td76q7j57o/tLVdgS746cYARfSyxk8iEfRxewL9h4OMzYhbW4TAcppl0mT4eyqXddh6L/jwoM75mo7ixa/pCeQ==",
+ "license": "MIT",
+ "engines": {
+ "node": ">=18"
+ }
+ },
+ "node_modules/@img/sharp-darwin-arm64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-darwin-arm64/-/sharp-darwin-arm64-0.34.5.tgz",
+ "integrity": "sha512-imtQ3WMJXbMY4fxb/Ndp6HBTNVtWCUI0WdobyheGf5+ad6xX8VIDO8u2xE4qc/fr08CKG/7dDseFtn6M6g/r3w==",
+ "cpu": [
+ "arm64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "darwin"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-darwin-arm64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-darwin-x64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-darwin-x64/-/sharp-darwin-x64-0.34.5.tgz",
+ "integrity": "sha512-YNEFAF/4KQ/PeW0N+r+aVVsoIY0/qxxikF2SWdp+NRkmMB7y9LBZAVqQ4yhGCm/H3H270OSykqmQMKLBhBJDEw==",
+ "cpu": [
+ "x64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "darwin"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-darwin-x64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-libvips-darwin-arm64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-darwin-arm64/-/sharp-libvips-darwin-arm64-1.2.4.tgz",
+ "integrity": "sha512-zqjjo7RatFfFoP0MkQ51jfuFZBnVE2pRiaydKJ1G/rHZvnsrHAOcQALIi9sA5co5xenQdTugCvtb1cuf78Vf4g==",
+ "cpu": [
+ "arm64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "darwin"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-darwin-x64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-darwin-x64/-/sharp-libvips-darwin-x64-1.2.4.tgz",
+ "integrity": "sha512-1IOd5xfVhlGwX+zXv2N93k0yMONvUlANylbJw1eTah8K/Jtpi15KC+WSiaX/nBmbm2HxRM1gZ0nSdjSsrZbGKg==",
+ "cpu": [
+ "x64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "darwin"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linux-arm": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linux-arm/-/sharp-libvips-linux-arm-1.2.4.tgz",
+ "integrity": "sha512-bFI7xcKFELdiNCVov8e44Ia4u2byA+l3XtsAj+Q8tfCwO6BQ8iDojYdvoPMqsKDkuoOo+X6HZA0s0q11ANMQ8A==",
+ "cpu": [
+ "arm"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linux-arm64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linux-arm64/-/sharp-libvips-linux-arm64-1.2.4.tgz",
+ "integrity": "sha512-excjX8DfsIcJ10x1Kzr4RcWe1edC9PquDRRPx3YVCvQv+U5p7Yin2s32ftzikXojb1PIFc/9Mt28/y+iRklkrw==",
+ "cpu": [
+ "arm64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linux-ppc64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linux-ppc64/-/sharp-libvips-linux-ppc64-1.2.4.tgz",
+ "integrity": "sha512-FMuvGijLDYG6lW+b/UvyilUWu5Ayu+3r2d1S8notiGCIyYU/76eig1UfMmkZ7vwgOrzKzlQbFSuQfgm7GYUPpA==",
+ "cpu": [
+ "ppc64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linux-riscv64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linux-riscv64/-/sharp-libvips-linux-riscv64-1.2.4.tgz",
+ "integrity": "sha512-oVDbcR4zUC0ce82teubSm+x6ETixtKZBh/qbREIOcI3cULzDyb18Sr/Wcyx7NRQeQzOiHTNbZFF1UwPS2scyGA==",
+ "cpu": [
+ "riscv64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linux-s390x": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linux-s390x/-/sharp-libvips-linux-s390x-1.2.4.tgz",
+ "integrity": "sha512-qmp9VrzgPgMoGZyPvrQHqk02uyjA0/QrTO26Tqk6l4ZV0MPWIW6LTkqOIov+J1yEu7MbFQaDpwdwJKhbJvuRxQ==",
+ "cpu": [
+ "s390x"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linux-x64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linux-x64/-/sharp-libvips-linux-x64-1.2.4.tgz",
+ "integrity": "sha512-tJxiiLsmHc9Ax1bz3oaOYBURTXGIRDODBqhveVHonrHJ9/+k89qbLl0bcJns+e4t4rvaNBxaEZsFtSfAdquPrw==",
+ "cpu": [
+ "x64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linuxmusl-arm64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linuxmusl-arm64/-/sharp-libvips-linuxmusl-arm64-1.2.4.tgz",
+ "integrity": "sha512-FVQHuwx1IIuNow9QAbYUzJ+En8KcVm9Lk5+uGUQJHaZmMECZmOlix9HnH7n1TRkXMS0pGxIJokIVB9SuqZGGXw==",
+ "cpu": [
+ "arm64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-libvips-linuxmusl-x64": {
+ "version": "1.2.4",
+ "resolved": "https://registry.npmjs.org/@img/sharp-libvips-linuxmusl-x64/-/sharp-libvips-linuxmusl-x64-1.2.4.tgz",
+ "integrity": "sha512-+LpyBk7L44ZIXwz/VYfglaX/okxezESc6UxDSoyo2Ks6Jxc4Y7sGjpgU9s4PMgqgjj1gZCylTieNamqA1MF7Dg==",
+ "cpu": [
+ "x64"
+ ],
+ "license": "LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-linux-arm": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linux-arm/-/sharp-linux-arm-0.34.5.tgz",
+ "integrity": "sha512-9dLqsvwtg1uuXBGZKsxem9595+ujv0sJ6Vi8wcTANSFpwV/GONat5eCkzQo/1O6zRIkh0m/8+5BjrRr7jDUSZw==",
+ "cpu": [
+ "arm"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linux-arm": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-linux-arm64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linux-arm64/-/sharp-linux-arm64-0.34.5.tgz",
+ "integrity": "sha512-bKQzaJRY/bkPOXyKx5EVup7qkaojECG6NLYswgktOZjaXecSAeCWiZwwiFf3/Y+O1HrauiE3FVsGxFg8c24rZg==",
+ "cpu": [
+ "arm64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linux-arm64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-linux-ppc64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linux-ppc64/-/sharp-linux-ppc64-0.34.5.tgz",
+ "integrity": "sha512-7zznwNaqW6YtsfrGGDA6BRkISKAAE1Jo0QdpNYXNMHu2+0dTrPflTLNkpc8l7MUP5M16ZJcUvysVWWrMefZquA==",
+ "cpu": [
+ "ppc64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linux-ppc64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-linux-riscv64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linux-riscv64/-/sharp-linux-riscv64-0.34.5.tgz",
+ "integrity": "sha512-51gJuLPTKa7piYPaVs8GmByo7/U7/7TZOq+cnXJIHZKavIRHAP77e3N2HEl3dgiqdD/w0yUfiJnII77PuDDFdw==",
+ "cpu": [
+ "riscv64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linux-riscv64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-linux-s390x": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linux-s390x/-/sharp-linux-s390x-0.34.5.tgz",
+ "integrity": "sha512-nQtCk0PdKfho3eC5MrbQoigJ2gd1CgddUMkabUj+rBevs8tZ2cULOx46E7oyX+04WGfABgIwmMC0VqieTiR4jg==",
+ "cpu": [
+ "s390x"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linux-s390x": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-linux-x64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linux-x64/-/sharp-linux-x64-0.34.5.tgz",
+ "integrity": "sha512-MEzd8HPKxVxVenwAa+JRPwEC7QFjoPWuS5NZnBt6B3pu7EG2Ge0id1oLHZpPJdn3OQK+BQDiw9zStiHBTJQQQQ==",
+ "cpu": [
+ "x64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linux-x64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-linuxmusl-arm64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linuxmusl-arm64/-/sharp-linuxmusl-arm64-0.34.5.tgz",
+ "integrity": "sha512-fprJR6GtRsMt6Kyfq44IsChVZeGN97gTD331weR1ex1c1rypDEABN6Tm2xa1wE6lYb5DdEnk03NZPqA7Id21yg==",
+ "cpu": [
+ "arm64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linuxmusl-arm64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-linuxmusl-x64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-linuxmusl-x64/-/sharp-linuxmusl-x64-0.34.5.tgz",
+ "integrity": "sha512-Jg8wNT1MUzIvhBFxViqrEhWDGzqymo3sV7z7ZsaWbZNDLXRJZoRGrjulp60YYtV4wfY8VIKcWidjojlLcWrd8Q==",
+ "cpu": [
+ "x64"
+ ],
+ "license": "Apache-2.0",
+ "optional": true,
+ "os": [
+ "linux"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-libvips-linuxmusl-x64": "1.2.4"
+ }
+ },
+ "node_modules/@img/sharp-wasm32": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-wasm32/-/sharp-wasm32-0.34.5.tgz",
+ "integrity": "sha512-OdWTEiVkY2PHwqkbBI8frFxQQFekHaSSkUIJkwzclWZe64O1X4UlUjqqqLaPbUpMOQk6FBu/HtlGXNblIs0huw==",
+ "cpu": [
+ "wasm32"
+ ],
+ "license": "Apache-2.0 AND LGPL-3.0-or-later AND MIT",
+ "optional": true,
+ "dependencies": {
+ "@emnapi/runtime": "^1.7.0"
+ },
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-win32-arm64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-win32-arm64/-/sharp-win32-arm64-0.34.5.tgz",
+ "integrity": "sha512-WQ3AgWCWYSb2yt+IG8mnC6Jdk9Whs7O0gxphblsLvdhSpSTtmu69ZG1Gkb6NuvxsNACwiPV6cNSZNzt0KPsw7g==",
+ "cpu": [
+ "arm64"
+ ],
+ "license": "Apache-2.0 AND LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "win32"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-win32-ia32": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-win32-ia32/-/sharp-win32-ia32-0.34.5.tgz",
+ "integrity": "sha512-FV9m/7NmeCmSHDD5j4+4pNI8Cp3aW+JvLoXcTUo0IqyjSfAZJ8dIUmijx1qaJsIiU+Hosw6xM5KijAWRJCSgNg==",
+ "cpu": [
+ "ia32"
+ ],
+ "license": "Apache-2.0 AND LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "win32"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
+ "node_modules/@img/sharp-win32-x64": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/@img/sharp-win32-x64/-/sharp-win32-x64-0.34.5.tgz",
+ "integrity": "sha512-+29YMsqY2/9eFEiW93eqWnuLcWcufowXewwSNIT6UwZdUUCrM3oFjMWH/Z6/TMmb4hlFenmfAVbpWeup2jryCw==",
+ "cpu": [
+ "x64"
+ ],
+ "license": "Apache-2.0 AND LGPL-3.0-or-later",
+ "optional": true,
+ "os": [
+ "win32"
+ ],
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ }
+ },
"node_modules/@isaacs/cliui": {
"version": "9.0.0",
"resolved": "https://registry.npmjs.org/@isaacs/cliui/-/cliui-9.0.0.tgz",
@@ -5294,6 +5770,50 @@
"integrity": "sha512-KiKBS8AnWGEyLzofFfmvKwpdPzqiy16LvQfK3yv/fVH7Bj13/wl3JSR1J+rfgRE9q7xUJK4qvgS8raSOeLUehw==",
"license": "ISC"
},
+ "node_modules/sharp": {
+ "version": "0.34.5",
+ "resolved": "https://registry.npmjs.org/sharp/-/sharp-0.34.5.tgz",
+ "integrity": "sha512-Ou9I5Ft9WNcCbXrU9cMgPBcCK8LiwLqcbywW3t4oDV37n1pzpuNLsYiAV8eODnjbtQlSDwZ2cUEeQz4E54Hltg==",
+ "hasInstallScript": true,
+ "license": "Apache-2.0",
+ "dependencies": {
+ "@img/colour": "^1.0.0",
+ "detect-libc": "^2.1.2",
+ "semver": "^7.7.3"
+ },
+ "engines": {
+ "node": "^18.17.0 || ^20.3.0 || >=21.0.0"
+ },
+ "funding": {
+ "url": "https://opencollective.com/libvips"
+ },
+ "optionalDependencies": {
+ "@img/sharp-darwin-arm64": "0.34.5",
+ "@img/sharp-darwin-x64": "0.34.5",
+ "@img/sharp-libvips-darwin-arm64": "1.2.4",
+ "@img/sharp-libvips-darwin-x64": "1.2.4",
+ "@img/sharp-libvips-linux-arm": "1.2.4",
+ "@img/sharp-libvips-linux-arm64": "1.2.4",
+ "@img/sharp-libvips-linux-ppc64": "1.2.4",
+ "@img/sharp-libvips-linux-riscv64": "1.2.4",
+ "@img/sharp-libvips-linux-s390x": "1.2.4",
+ "@img/sharp-libvips-linux-x64": "1.2.4",
+ "@img/sharp-libvips-linuxmusl-arm64": "1.2.4",
+ "@img/sharp-libvips-linuxmusl-x64": "1.2.4",
+ "@img/sharp-linux-arm": "0.34.5",
+ "@img/sharp-linux-arm64": "0.34.5",
+ "@img/sharp-linux-ppc64": "0.34.5",
+ "@img/sharp-linux-riscv64": "0.34.5",
+ "@img/sharp-linux-s390x": "0.34.5",
+ "@img/sharp-linux-x64": "0.34.5",
+ "@img/sharp-linuxmusl-arm64": "0.34.5",
+ "@img/sharp-linuxmusl-x64": "0.34.5",
+ "@img/sharp-wasm32": "0.34.5",
+ "@img/sharp-win32-arm64": "0.34.5",
+ "@img/sharp-win32-ia32": "0.34.5",
+ "@img/sharp-win32-x64": "0.34.5"
+ }
+ },
"node_modules/shebang-command": {
"version": "2.0.0",
"resolved": "https://registry.npmjs.org/shebang-command/-/shebang-command-2.0.0.tgz",
diff --git a/package.json b/package.json
@@ -5,8 +5,8 @@
"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 --external:prom-client && elm make src/Client.elm --output=client.js",
- "release": "npx spago build && npx purs-backend-es build && npx esbuild output-es/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 --external:prom-client && elm make src/Client.elm --optimize --output=client.js && npx uglifyjs client.js --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\" | npx uglifyjs --mangle --output client.js",
+ "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 --external:prom-client --external:sharp && elm make src/Client.elm --output=client.js",
+ "release": "npx spago build && npx purs-backend-es build && npx esbuild output-es/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 --external:prom-client --external:sharp && elm make src/Client.elm --optimize --output=client.js && npx uglifyjs client.js --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\" | npx uglifyjs --mangle --output client.js",
"test": "npx spago test",
"tidy": "purs-tidy format-in-place src/**/*.purs"
},
@@ -25,6 +25,7 @@
"@aws-sdk/client-s3": "^3.1029.0",
"dotenv": "^17.4.1",
"duckdb": "^1.4.4",
- "prom-client": "^15.1.3"
+ "prom-client": "^15.1.3",
+ "sharp": "^0.34.5"
}
}
diff --git a/spago.lock b/spago.lock
@@ -6,6 +6,7 @@
"core": {
"dependencies": [
"aff",
+ "aff-promise",
"aff-retry",
"argonaut",
"argonaut-core",
@@ -721,6 +722,21 @@
"unsafe-coerce"
]
},
+ "aff-promise": {
+ "type": "registry",
+ "version": "4.0.0",
+ "integrity": "sha256-Jgp3y+NWuuAmwz2V3LlWoX+AvxqfVglY77N5zTw8xnI=",
+ "dependencies": [
+ "aff",
+ "control",
+ "effect",
+ "either",
+ "exceptions",
+ "foreign",
+ "prelude",
+ "transformers"
+ ]
+ },
"aff-retry": {
"type": "registry",
"version": "2.0.0",
diff --git a/spago.yaml b/spago.yaml
@@ -2,6 +2,7 @@ package:
name: corpus
dependencies:
- aff
+ - aff-promise
- aff-retry
- argonaut
- argonaut-core
diff --git a/src/Api.elm b/src/Api.elm
@@ -0,0 +1,209 @@
+module Api exposing (fetchListens, fetchSectionData, fetchSimilarTracks, fetchStats, httpErrorToString, listensDecoder, sectionEntriesDecoder, similarTracksDecoder, statsDecoder, statsUrl)
+
+import Http
+import Json.Decode as D exposing (Decoder)
+import Types exposing (ActiveFilter, Listen, Msg(..), Period(..), SimilarTrack, Stats, StatsEntry)
+import Url
+
+
+fetchListens : String -> Int -> Int -> Maybe ActiveFilter -> Maybe String -> Cmd Msg
+fetchListens userSlug limit offset mFilter mSearch =
+ let
+ filterParams =
+ case mFilter of
+ Nothing ->
+ ""
+
+ Just { field, value } ->
+ "&filterField=" ++ field ++ "&filterValue=" ++ Url.percentEncode value
+
+ searchParam =
+ case mSearch of
+ Nothing ->
+ ""
+
+ Just q ->
+ "&search=" ++ Url.percentEncode q
+
+ url =
+ "/proxy?user=" ++ userSlug ++ "&limit=" ++ String.fromInt limit ++ "&offset=" ++ String.fromInt offset ++ filterParams ++ searchParam
+ in
+ Http.get
+ { url = url
+ , expect = Http.expectJson GotListens listensDecoder
+ }
+
+
+fetchStats : String -> Period -> Cmd Msg
+fetchStats userSlug period =
+ Http.get
+ { url = statsUrl userSlug period Nothing
+ , expect = Http.expectJson GotStats statsDecoder
+ }
+
+
+fetchSectionData : String -> Period -> String -> Cmd Msg
+fetchSectionData userSlug period section =
+ Http.get
+ { url = statsUrl userSlug period (Just section)
+ , expect = Http.expectJson (GotSectionData section) (sectionEntriesDecoder section)
+ }
+
+
+statsUrl : String -> Period -> Maybe String -> String
+statsUrl userSlug 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 ->
+ "§ion=" ++ sec
+ in
+ "/stats?user=" ++ userSlug ++ periodPart ++ sectionPart
+
+
+fetchSimilarTracks : String -> String -> Cmd Msg
+fetchSimilarTracks artist track =
+ Http.get
+ { url = "/similar?artist=" ++ Url.percentEncode artist ++ "&track=" ++ Url.percentEncode track
+ , expect = Http.expectJson (FetchSimilarTracks artist track) similarTracksDecoder
+ }
+
+
+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
+ , label = meta.label
+ , 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
+ , label : Maybe String
+ }
+
+
+trackMetaDecoder : Decoder TrackMeta
+trackMetaDecoder =
+ D.map7 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))
+ (D.maybe (D.field "label" 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
+
+
+similarTracksDecoder : Decoder (List SimilarTrack)
+similarTracksDecoder =
+ D.at [ "data", "similar_tracks" ] (D.list similarTrackDecoder)
+
+
+similarTrackDecoder : Decoder SimilarTrack
+similarTrackDecoder =
+ D.map4 SimilarTrack
+ (D.field "artist" D.string)
+ (D.field "track" D.string)
+ (D.maybe (D.field "score" D.float))
+ (D.maybe (D.field "video_uri" D.string))
diff --git a/src/Client.elm b/src/Client.elm
@@ -1,1419 +1,18 @@
-port module Client exposing (main)
+module Client exposing (main)
import Browser
-import Dict exposing (Dict)
-import Html exposing (Html, a, button, div, h1, h2, img, input, li, p, span, strong, text, ul)
-import Html.Attributes as Attr exposing (class, disabled, href, placeholder, src, style, target, type_, value)
-import Html.Events exposing (on, onClick, 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
-
-
-type alias UserInfo =
- { slug : String
- , name : String
- }
-
-
-type alias Flags =
- { search : String
- , userSlug : String
- , allUsers : List UserInfo
- }
+import State exposing (init, subscriptions, update)
+import Types exposing (Flags, Model, Msg(..))
+import View exposing (view)
main : Program Flags Model Msg
main =
- Browser.element
+ Browser.application
{ init = init
+ , onUrlRequest = UrlRequested
+ , onUrlChange = UrlChanged
, update = update
, view = view
, subscriptions = subscriptions
}
-
-
-
--- TYPES
-
-
-type Tab
- = ListensTab
- | StatsTab
- | AboutTab
-
-
-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
- , label : 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
- }
-
-
-type alias SimilarTrack =
- { artist : String
- , track : String
- , score : Maybe Float
- , videoUri : Maybe String
- }
-
-
-type SimilarState
- = SimilarLoading
- | SimilarLoaded (List SimilarTrack)
- | SimilarError String
-
-
-
--- MODEL
-
-
-type alias Model =
- { listens : List Listen
- , stats : Maybe Stats
- , 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
- , userSlug : String
- , similarStates : Dict String SimilarState
- , allUsers : List UserInfo
- , searchInput : String
- , activeSearch : Maybe String
- }
-
-
-init : Flags -> ( Model, Cmd Msg )
-init flags =
- let
- page =
- parsePageParam flags.search
-
- offset =
- max 0 ((page - 1) * 25)
- in
- ( { listens = []
- , stats = 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
- , userSlug = flags.userSlug
- , similarStates = Dict.empty
- , allUsers = flags.allUsers
- , searchInput = ""
- , activeSearch = Nothing
- }
- , Cmd.batch
- [ fetchListens flags.userSlug 25 offset Nothing 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
- | FetchSimilar String String
- | FetchSimilarTracks String String (Result Http.Error (List SimilarTrack))
- | UpdateSearchInput String
- | SubmitSearch
- | ClearSearch
-
-
-
--- 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.userSlug model.limit model.offset model.activeFilter model.activeSearch
- )
-
- else
- ( { model | currentTime = Just time }, Cmd.none )
-
- GotTime time ->
- ( { model | 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.userSlug model.limit newOffset model.activeFilter model.activeSearch
- , 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.userSlug model.limit newOffset model.activeFilter model.activeSearch
- , pushUrl ("?page=" ++ String.fromInt page)
- ]
- )
-
- SwitchTab tab ->
- ( { model | activeTab = tab }
- , case tab of
- StatsTab ->
- if model.stats == Nothing then
- fetchStats model.userSlug model.statsPeriod
-
- else
- Cmd.none
-
- ListensTab ->
- Cmd.none
-
- AboutTab ->
- Cmd.none
- )
-
- SetStatsPeriod period ->
- ( { model
- | statsPeriod = period
- , stats = Nothing
- , expandedSections = Set.empty
- , loadedSections = Set.empty
- , showCustomInput = False
- }
- , fetchStats model.userSlug 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 model.userSlug 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, activeSearch = Nothing, searchInput = "", offset = 0, activeTab = ListensTab, loading = True }
- , Cmd.batch
- [ fetchListens model.userSlug model.limit 0 filter Nothing
- , pushUrl "?page=1"
- ]
- )
-
- ClearFilter ->
- ( { model | activeFilter = Nothing, offset = 0, loading = True }
- , Cmd.batch
- [ fetchListens model.userSlug model.limit 0 Nothing model.activeSearch
- , pushUrl "?page=1"
- ]
- )
-
- UpdateSearchInput str ->
- ( { model | searchInput = str }, Cmd.none )
-
- SubmitSearch ->
- let
- q =
- String.trim model.searchInput
- in
- if String.isEmpty q then
- ( { model | activeSearch = Nothing, offset = 0, loading = True }
- , Cmd.batch
- [ fetchListens model.userSlug model.limit 0 Nothing Nothing
- , pushUrl "?page=1"
- ]
- )
-
- else
- ( { model | activeSearch = Just q, activeFilter = Nothing, offset = 0, loading = True }
- , Cmd.batch
- [ fetchListens model.userSlug model.limit 0 Nothing (Just q)
- , pushUrl "?page=1"
- ]
- )
-
- ClearSearch ->
- ( { model | searchInput = "", activeSearch = Nothing, offset = 0, loading = True }
- , Cmd.batch
- [ fetchListens model.userSlug model.limit 0 Nothing 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.userSlug model.statsPeriod section )
-
- CollapseSection section ->
- ( { model
- | expandedSections = Set.remove section model.expandedSections
- , loadedSections = Set.remove section model.loadedSections
- }
- , Cmd.none
- )
-
- FetchSimilar artist track ->
- let
- key =
- artist ++ "\t" ++ track
- in
- if Dict.member key model.similarStates then
- ( { model | similarStates = Dict.remove key model.similarStates }, Cmd.none )
-
- else
- ( { model | similarStates = Dict.insert key SimilarLoading model.similarStates }
- , fetchSimilarTracks artist track
- )
-
- FetchSimilarTracks artist track result ->
- let
- key =
- artist ++ "\t" ++ track
-
- newStates =
- case result of
- Ok tracks ->
- Dict.insert key (SimilarLoaded tracks) model.similarStates
-
- Err err ->
- Dict.insert key (SimilarError (httpErrorToString err)) model.similarStates
- in
- ( { model | similarStates = newStates }, 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 : String -> Int -> Int -> Maybe ActiveFilter -> Maybe String -> Cmd Msg
-fetchListens userSlug limit offset mFilter mSearch =
- let
- filterParams =
- case mFilter of
- Nothing ->
- ""
-
- Just { field, value } ->
- "&filterField=" ++ field ++ "&filterValue=" ++ Url.percentEncode value
-
- searchParam =
- case mSearch of
- Nothing ->
- ""
-
- Just q ->
- "&search=" ++ Url.percentEncode q
-
- url =
- "/proxy?user=" ++ userSlug ++ "&limit=" ++ String.fromInt limit ++ "&offset=" ++ String.fromInt offset ++ filterParams ++ searchParam
- in
- Http.get
- { url = url
- , expect = Http.expectJson GotListens listensDecoder
- }
-
-
-fetchStats : String -> Period -> Cmd Msg
-fetchStats userSlug period =
- Http.get
- { url = statsUrl userSlug period Nothing
- , expect = Http.expectJson GotStats statsDecoder
- }
-
-
-fetchSectionData : String -> Period -> String -> Cmd Msg
-fetchSectionData userSlug period section =
- Http.get
- { url = statsUrl userSlug period (Just section)
- , expect = Http.expectJson (GotSectionData section) (sectionEntriesDecoder section)
- }
-
-
-statsUrl : String -> Period -> Maybe String -> String
-statsUrl userSlug 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 ->
- "§ion=" ++ sec
- in
- "/stats?user=" ++ userSlug ++ periodPart ++ sectionPart
-
-
-fetchSimilarTracks : String -> String -> Cmd Msg
-fetchSimilarTracks artist track =
- Http.get
- { url = "/similar?artist=" ++ Url.percentEncode artist ++ "&track=" ++ Url.percentEncode track
- , expect = Http.expectJson (FetchSimilarTracks artist track) similarTracksDecoder
- }
-
-
-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
- , label = meta.label
- , 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
- , label : Maybe String
- }
-
-
-trackMetaDecoder : Decoder TrackMeta
-trackMetaDecoder =
- D.map7 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))
- (D.maybe (D.field "label" 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
-
-
-similarTracksDecoder : Decoder (List SimilarTrack)
-similarTracksDecoder =
- D.at [ "data", "similar_tracks" ] (D.list similarTrackDecoder)
-
-
-similarTrackDecoder : Decoder SimilarTrack
-similarTrackDecoder =
- D.map4 SimilarTrack
- (D.field "artist" D.string)
- (D.field "track" D.string)
- (D.maybe (D.field "score" D.float))
- (D.maybe (D.field "video_uri" D.string))
-
-
-
--- 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
- (if model.userSlug == "" then
- "/"
-
- else
- "/u/" ++ model.userSlug
- )
- ]
- [ text "listens" ]
- , button
- [ class
- ("tab-btn"
- ++ (if model.activeTab == StatsTab then
- " active"
-
- else
- ""
- )
- )
- , onClick (SwitchTab StatsTab)
- ]
- [ text "stats" ]
- , button
- [ class
- ("tab-btn"
- ++ (if model.activeTab == AboutTab then
- " active"
-
- else
- ""
- )
- )
- , onClick (SwitchTab AboutTab)
- ]
- [ text "about" ]
- ]
- , case model.activeTab of
- ListensTab ->
- div []
- [ div [ class "search-bar" ]
- [ input
- [ type_ "text"
- , class "search-input"
- , placeholder "search by track, artist, album or label"
- , value model.searchInput
- , onInput UpdateSearchInput
- , onEnter SubmitSearch
- ]
- []
- , button [ class "search-btn", onClick SubmitSearch ] [ text "search" ]
- , case model.activeSearch of
- Just _ ->
- button [ class "filter-clear", onClick ClearSearch ] [ text "✕ clear" ]
-
- Nothing ->
- text ""
- ]
- , 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
- ]
-
- AboutTab ->
- renderAboutView model.userSlug model.allUsers
- ]
-
-
-renderContent : Model -> Html Msg
-renderContent model =
- if model.loading && List.isEmpty model.listens then
- ul [] [ li [ class "loading" ] [ text "⏳" ] ]
-
- else
- case model.error of
- Just err ->
- ul [] [ li [ class "error" ] [ text err ] ]
-
- Nothing ->
- div [ class "tracks-with-similar" ]
- (List.indexedMap
- (\idx listen ->
- let
- artist =
- Maybe.withDefault "" listen.artistName
-
- trackName =
- Maybe.withDefault "" listen.trackName
-
- key =
- artist ++ "\t" ++ trackName
- in
- div [ class "track-with-similar-container" ]
- [ ul [ class "track-item" ]
- [ renderListen model.userSlug model.currentTime model.failedCovers model.hoveredCover model.similarStates idx listen ]
- , renderSimilarPanel model.similarStates key
- ]
- )
- model.listens
- )
-
-
-renderListen : String -> Maybe Time.Posix -> Set String -> Maybe Int -> Dict String SimilarState -> Int -> Listen -> Html Msg
-renderListen userSlug currentTime failedCovers hoveredCover similarStates idx listen =
- let
- artist =
- Maybe.withDefault "" listen.artistName
-
- trackName =
- Maybe.withDefault "" listen.trackName
-
- release =
- Maybe.withDefault "" listen.releaseName
-
- key =
- artist ++ "\t" ++ trackName
-
- mbid =
- case listen.caaReleaseMbid of
- Just m ->
- Just m
-
- Nothing ->
- listen.releaseMbid
-
- coverUrl =
- "/cover?user="
- ++ userSlug
- ++ "&artist="
- ++ Url.percentEncode artist
- ++ "&release="
- ++ Url.percentEncode release
- ++ (case mbid of
- Just m ->
- "&mbid=" ++ m
-
- Nothing ->
- ""
- )
-
- isZoomed =
- hoveredCover == Just idx
-
- isActive =
- Dict.member key similarStates
- in
- li [ class "success" ]
- [ div [ class "track-info" ]
- [ div [ class "track-name" ]
- [ button [ class "track-link", onClick (FilterBy "track" (Maybe.withDefault "Unknown Track" listen.trackName)) ] [ text (Maybe.withDefault "Unknown Track" listen.trackName) ] ]
- , div [ class "track-artist" ] [ button [ class "artist-link", onClick (FilterBy "artist" artist) ] [ text artist ] ]
- , div [ class "track-time" ]
- [ span []
- (button [ class "album-link", onClick (FilterBy "album" release) ] [ text release ]
- :: (case listen.label of
- Just l ->
- [ text " • "
- , button [ class "label-link", onClick (FilterBy "label" l) ] [ text l ]
- ]
-
- Nothing ->
- []
- )
- ++ [ 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 ""
- , if artist /= "" && trackName /= "" then
- button
- [ class
- ("similar-btn"
- ++ (if isActive then
- " active"
-
- else
- ""
- )
- )
- , onClick (FetchSimilar artist trackName)
- ]
- [ text "similar" ]
-
- else
- text ""
- ]
- ]
-
-
-renderSimilarPanel : Dict String SimilarState -> String -> Html Msg
-renderSimilarPanel similarStates key =
- case Dict.get key similarStates of
- Nothing ->
- text ""
-
- Just SimilarLoading ->
- div [ class "similar-panel" ]
- [ div [ class "similar-loading" ] [ text "⏳" ] ]
-
- Just (SimilarError err) ->
- div [ class "similar-panel" ]
- [ div [ class "similar-error" ] [ text err ] ]
-
- Just (SimilarLoaded tracks) ->
- div [ class "similar-panel" ]
- [ if List.isEmpty tracks then
- div [ class "similar-empty" ] [ text "no similar songs found" ]
-
- else
- div [] (List.map renderSimilarTrack tracks)
- ]
-
-
-renderSimilarTrack : SimilarTrack -> Html Msg
-renderSimilarTrack track =
- div [ class "similar-track" ]
- [ div [ class "similar-track-info" ]
- [ div [ class "similar-track-name" ] [ text track.track ]
- , div [ class "similar-track-artist" ] [ text track.artist ]
- ]
- , case track.score of
- Just score ->
- span [ class "similar-score" ]
- [ text (String.fromInt (round (score * 100)) ++ "%") ]
-
- Nothing ->
- text ""
- , case track.videoUri of
- Just link ->
- a [ class "similar-link", href link, target "_blank" ]
- [ text "▶" ]
-
- Nothing ->
- text ""
- ]
-
-
-renderStatsView : Set String -> Set String -> Maybe Stats -> Html Msg
-renderStatsView expandedSections loadedSections mStats =
- case mStats of
- Nothing ->
- div [ class "loading" ] [ text "⏳" ]
-
- 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 "beyond here lies nothing" ]
-
- 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 ""
- ]
-
-
-onEnter : msg -> Html.Attribute msg
-onEnter msg =
- on "keydown"
- (D.field "key" D.string
- |> D.andThen
- (\key ->
- if key == "Enter" then
- D.succeed msg
-
- else
- D.fail "not enter"
- )
- )
-
-
-
--- 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"
-
-
-renderAboutView : String -> List UserInfo -> Html Msg
-renderAboutView currentSlug allUsers =
- let
- otherUsers =
- List.filter (\u -> u.slug /= currentSlug) allUsers
-
- userLink { slug, name } =
- let
- url =
- if slug == "" then
- "/"
-
- else
- "/u/" ++ slug
- in
- li [] [ a [ href url ] [ text name ] ]
-
- extLink url label =
- a [ href url, target "_blank", class "about-link" ] [ text label ]
- in
- div []
- [ p [ class "about-lead" ]
- [ text "corpus is a self-hosted listen history proxy that syncs scrobbles from "
- , extLink "https://listenbrainz.org" "ListenBrainz"
- , text " and "
- , extLink "https://www.last.fm" "Last.fm."
- ]
- , div [ class "stats-section" ]
- [ h2 [] [ text "features" ]
- , ul [ class "about-list" ]
- [ li [] [ text "searchable listen history with pagination" ]
- , li [] [ text "stats by artist, track, label, year, and genre" ]
- , li [] [ text "filter listens by label, artist, genre, or year" ]
- , li [] [ text "cover art from Cover Art Archive, Last.fm, and Discogs" ]
- , li [] [ text "similar track discovery via cosine.club" ]
- , li [] [ text "metadata enrichment via MusicBrainz, Last.fm, and Discogs" ]
- ]
- ]
- , div [ class "stats-section" ]
- [ h2 [] [ text "links" ]
- , p [ class "about-meta" ]
- [ div [] [ extLink "https://instagram.com/counterpoint303" "counterpoint" ]
- , div [] [ extLink "https://github.com/mtmn/corpus" "github repo" ]
- , div [] [ extLink "https://mtmn.name" "mtmn.name" ]
- ]
- ]
- , if List.isEmpty otherUsers then
- text ""
-
- else
- div [ class "stats-section" ]
- [ h2 [] [ text "friends" ]
- , ul [ class "about-users" ]
- (List.map userLink otherUsers)
- ]
- ]
diff --git a/src/Image.js b/src/Image.js
@@ -0,0 +1,14 @@
+import sharp from 'sharp';
+
+export const convertToAvifImpl = (buffer) => () => {
+ return sharp(buffer)
+ .avif()
+ .toBuffer()
+ .then(resultBuffer => {
+ // Extract the underlying ArrayBuffer
+ return resultBuffer.buffer.slice(
+ resultBuffer.byteOffset,
+ resultBuffer.byteOffset + resultBuffer.byteLength
+ );
+ });
+};
diff --git a/src/Image.purs b/src/Image.purs
@@ -0,0 +1,12 @@
+module Image (convertToAvif) where
+
+import Prelude
+import Control.Promise (Promise, toAffE)
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Data.ArrayBuffer.Types (ArrayBuffer)
+
+foreign import convertToAvifImpl :: ArrayBuffer -> Effect (Promise ArrayBuffer)
+
+convertToAvif :: ArrayBuffer -> Aff ArrayBuffer
+convertToAvif = toAffE <<< convertToAvifImpl
diff --git a/src/Main.purs b/src/Main.purs
@@ -30,8 +30,10 @@ import Effect.Aff.AVar (AVar)
import Effect.Aff.AVar as Avar
import Unsafe.Coerce (unsafeCoerce)
import Node.FS.Aff as FSA
-import Fetch (fetch, Method(GET), lookup)
+import Fetch (fetch, Method(GET))
import Fetch.Argonaut.Json (fromJson)
+import Data.Map as Map
+import Data.String.CaseInsensitive (CaseInsensitiveString(..))
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import JSURI (encodeURIComponent)
import Foreign.Object as Object
@@ -57,6 +59,7 @@ import Web.URL (URL)
import Web.URL as URL
import Web.URL.URLSearchParams as URLSearchParams
import Templates (indexHtml)
+import Image (convertToAvif)
-- Types
type Request = IncomingMessage IMServer
@@ -513,19 +516,19 @@ coverSources mbid artist release cfg =
safeRelease = sanitizeKey release
in
[ { name: "caa"
- , s3Key: "covers/caa/" <> sanitizeKey mbid <> ".jpg"
+ , s3Key: "covers/caa/" <> sanitizeKey mbid <> ".avif"
, findUrl:
if mbid == "" then pure Nothing
else pure $ Just $ "https://coverartarchive.org/release/" <> mbid <> "/front-250"
}
, { name: "lastfm"
- , s3Key: "covers/lastfm/" <> safeArtist <> "-" <> safeRelease <> ".jpg"
+ , s3Key: "covers/lastfm/" <> safeArtist <> "-" <> safeRelease <> ".avif"
, findUrl:
if artist == "" || release == "" then pure Nothing
else fetchLastfmCoverUrl cfg artist release
}
, { name: "discogs"
- , s3Key: "covers/discogs/" <> safeArtist <> "-" <> safeRelease <> ".jpg"
+ , s3Key: "covers/discogs/" <> safeArtist <> "-" <> safeRelease <> ".avif"
, findUrl:
if artist == "" || release == "" then pure Nothing
else fetchDiscogsCoverUrl cfg artist release
@@ -581,19 +584,24 @@ serveCover cfg slug url res = launchAff_ do
fetchResult <- try $ fetch urlStr { method: GET }
case fetchResult of
Right fr | fr.status == 200 -> do
- Log.info $ "Proxying and caching image: " <> urlStr
- let contentType = fromMaybe "image/jpeg" $ lookup "content-type" fr.headers
+ let
+ isAvif = case Map.lookup (CaseInsensitiveString "content-type") fr.headers of
+ Just ct | ct == "image/avif" -> true
+ _ -> false
+
+ Log.info $ "caching image (" <> (if isAvif then "already avif" else "needs conversion") <> "): " <> urlStr
buf <- fr.arrayBuffer
+ avifBuf <- if isAvif then pure buf else convertToAvif buf
liftEffect $ do
setStatusCode fr.status response
- setHeader "Content-Type" contentType (toOutgoingMessage response)
+ setHeader "Content-Type" "image/avif" (toOutgoingMessage response)
setHeader "Cache-Control" "public, max-age=86400" (toOutgoingMessage response)
let writer = toWriteable (toOutgoingMessage response)
- nativeBuf <- fromArrayBuffer buf
+ nativeBuf <- fromArrayBuffer avifBuf
void $ write writer nativeBuf
end writer
when cfg.coverCacheEnabled $ void $ forkAff $ do
- uploadResult <- try $ uploadToS3 s3cfg s3Key (unsafeCoerce buf) contentType
+ uploadResult <- try $ uploadToS3 s3cfg s3Key (unsafeCoerce avifBuf) "image/avif"
case uploadResult of
Right _ -> Log.info $ "Cached to S3: " <> s3Key
Left err -> Log.error $ "S3 upload failed: " <> Exception.message err
diff --git a/src/State.elm b/src/State.elm
@@ -0,0 +1,502 @@
+module State exposing (init, subscriptions, update)
+
+import Api exposing (fetchListens, fetchSectionData, fetchSimilarTracks, fetchStats, httpErrorToString)
+import Browser
+import Browser.Navigation as Nav
+import Dict
+import Set
+import Task
+import Time
+import Types exposing (Flags, Model, Msg(..), Period(..), SimilarState(..), Stats, StatsEntry, Tab(..))
+import Url
+import Url.Parser exposing ((</>), (<?>))
+import Url.Parser.Query as Query
+
+
+init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
+init flags url navKey =
+ let
+ page =
+ parsePageParam url
+
+ offset =
+ max 0 ((page - 1) * 25)
+ in
+ ( { navKey = navKey
+ , listens = []
+ , stats = 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
+ , userSlug = flags.userSlug
+ , similarStates = Dict.empty
+ , allUsers = flags.allUsers
+ , searchInput = ""
+ , activeSearch = Nothing
+ }
+ , Cmd.batch
+ [ fetchListens flags.userSlug 25 offset Nothing Nothing
+ , Task.perform GotTime Time.now
+ ]
+ )
+
+
+parsePageParam : Url.Url -> Int
+parsePageParam url =
+ let
+ pageParser =
+ Url.Parser.oneOf
+ [ Url.Parser.top <?> Query.int "page"
+ , (Url.Parser.s "u" </> Url.Parser.string <?> Query.int "page") |> Url.Parser.map (\_ p -> p)
+ ]
+ in
+ Url.Parser.parse pageParser url
+ |> Maybe.andThen identity
+ |> Maybe.withDefault 1
+
+
+
+-- MSG
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+ case msg of
+ UrlRequested urlRequest ->
+ case urlRequest of
+ Browser.Internal url ->
+ ( model, Nav.pushUrl model.navKey (Url.toString url) )
+
+ Browser.External href ->
+ ( model, Nav.load href )
+
+ UrlChanged url ->
+ let
+ newUserSlug =
+ if String.startsWith "/u/" url.path then
+ String.dropLeft 3 url.path
+
+ else
+ ""
+
+ page =
+ parsePageParam url
+
+ targetOffset =
+ max 0 ((page - 1) * model.limit)
+
+ isNaked =
+ url.query == Nothing
+
+ userChanged =
+ newUserSlug /= model.userSlug
+
+ needsCleanStart =
+ userChanged || isNaked
+
+ finalFilter =
+ if needsCleanStart then
+ Nothing
+
+ else
+ model.activeFilter
+
+ finalSearch =
+ if needsCleanStart then
+ Nothing
+
+ else
+ model.activeSearch
+
+ finalOffset =
+ if needsCleanStart then
+ 0
+
+ else
+ targetOffset
+ in
+ if userChanged || model.offset /= finalOffset || model.activeFilter /= finalFilter || model.activeSearch /= finalSearch then
+ let
+ newModel =
+ { model
+ | userSlug = newUserSlug
+ , offset = finalOffset
+ , activeFilter = finalFilter
+ , activeSearch = finalSearch
+ , searchInput =
+ if needsCleanStart then
+ ""
+
+ else
+ model.searchInput
+ , activeTab = ListensTab
+ , loading = True
+ }
+
+ clearedModel =
+ if userChanged then
+ { newModel
+ | stats = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , similarStates = Dict.empty
+ }
+
+ else
+ newModel
+ in
+ ( clearedModel
+ , fetchListens newUserSlug model.limit finalOffset finalFilter finalSearch
+ )
+
+ else
+ ( { model | activeTab = ListensTab }, Cmd.none )
+
+ Tick time ->
+ if not model.loading then
+ ( { model | currentTime = Just time, loading = True }
+ , fetchListens model.userSlug model.limit model.offset model.activeFilter model.activeSearch
+ )
+
+ else
+ ( { model | currentTime = Just time }, Cmd.none )
+
+ GotTime time ->
+ ( { model | 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
+
+ prefix =
+ if String.isEmpty model.userSlug then
+ "/"
+
+ else
+ "/u/" ++ model.userSlug
+ in
+ ( { model | offset = newOffset, loading = True }
+ , Cmd.batch
+ [ fetchListens model.userSlug model.limit newOffset model.activeFilter model.activeSearch
+ , Nav.pushUrl model.navKey (prefix ++ "?page=" ++ String.fromInt page)
+ ]
+ )
+
+ PrevPage ->
+ let
+ newOffset =
+ max 0 (model.offset - model.limit)
+
+ page =
+ newOffset // model.limit + 1
+
+ prefix =
+ if String.isEmpty model.userSlug then
+ "/"
+
+ else
+ "/u/" ++ model.userSlug
+ in
+ ( { model | offset = newOffset, loading = True }
+ , Cmd.batch
+ [ fetchListens model.userSlug model.limit newOffset model.activeFilter model.activeSearch
+ , Nav.pushUrl model.navKey (prefix ++ "?page=" ++ String.fromInt page)
+ ]
+ )
+
+ SwitchTab tab ->
+ ( { model | activeTab = tab }
+ , case tab of
+ StatsTab ->
+ if model.stats == Nothing then
+ fetchStats model.userSlug model.statsPeriod
+
+ else
+ Cmd.none
+
+ ListensTab ->
+ Cmd.none
+
+ AboutTab ->
+ Cmd.none
+ )
+
+ SetStatsPeriod period ->
+ ( { model
+ | statsPeriod = period
+ , stats = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , showCustomInput = False
+ }
+ , fetchStats model.userSlug 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 model.userSlug period
+ )
+
+ _ ->
+ ( { model | customError = Just "Enter two dates separated by a space" }, Cmd.none )
+
+ FilterBy field value ->
+ let
+ filter =
+ Just { field = field, value = value }
+
+ prefix =
+ if String.isEmpty model.userSlug then
+ "/"
+
+ else
+ "/u/" ++ model.userSlug
+ in
+ ( { model | activeFilter = filter, activeSearch = Nothing, searchInput = "", offset = 0, activeTab = ListensTab, loading = True }
+ , Cmd.batch
+ [ fetchListens model.userSlug model.limit 0 filter Nothing
+ , Nav.pushUrl model.navKey (prefix ++ "?page=1")
+ ]
+ )
+
+ ClearFilter ->
+ let
+ prefix =
+ if String.isEmpty model.userSlug then
+ "/"
+
+ else
+ "/u/" ++ model.userSlug
+ in
+ ( { model | activeFilter = Nothing, offset = 0, loading = True }
+ , Cmd.batch
+ [ fetchListens model.userSlug model.limit 0 Nothing model.activeSearch
+ , Nav.pushUrl model.navKey (prefix ++ "?page=1")
+ ]
+ )
+
+ UpdateSearchInput str ->
+ ( { model | searchInput = str }, Cmd.none )
+
+ SubmitSearch ->
+ let
+ q =
+ String.trim model.searchInput
+
+ prefix =
+ if String.isEmpty model.userSlug then
+ "/"
+
+ else
+ "/u/" ++ model.userSlug
+ in
+ if String.isEmpty q then
+ ( { model | activeSearch = Nothing, offset = 0, loading = True }
+ , Cmd.batch
+ [ fetchListens model.userSlug model.limit 0 Nothing Nothing
+ , Nav.pushUrl model.navKey (prefix ++ "?page=1")
+ ]
+ )
+
+ else
+ ( { model | activeSearch = Just q, activeFilter = Nothing, offset = 0, loading = True }
+ , Cmd.batch
+ [ fetchListens model.userSlug model.limit 0 Nothing (Just q)
+ , Nav.pushUrl model.navKey (prefix ++ "?page=1")
+ ]
+ )
+
+ ClearSearch ->
+ let
+ prefix =
+ if String.isEmpty model.userSlug then
+ "/"
+
+ else
+ "/u/" ++ model.userSlug
+ in
+ ( { model | searchInput = "", activeSearch = Nothing, offset = 0, loading = True }
+ , Cmd.batch
+ [ fetchListens model.userSlug model.limit 0 Nothing Nothing
+ , Nav.pushUrl model.navKey (prefix ++ "?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.userSlug model.statsPeriod section )
+
+ CollapseSection section ->
+ ( { model
+ | expandedSections = Set.remove section model.expandedSections
+ , loadedSections = Set.remove section model.loadedSections
+ }
+ , Cmd.none
+ )
+
+ FetchSimilar artist track ->
+ let
+ key =
+ artist ++ "\t" ++ track
+ in
+ if Dict.member key model.similarStates then
+ ( { model | similarStates = Dict.remove key model.similarStates }, Cmd.none )
+
+ else
+ ( { model | similarStates = Dict.insert key SimilarLoading model.similarStates }
+ , fetchSimilarTracks artist track
+ )
+
+ FetchSimilarTracks artist track result ->
+ let
+ key =
+ artist ++ "\t" ++ track
+
+ newStates =
+ case result of
+ Ok tracks ->
+ Dict.insert key (SimilarLoaded tracks) model.similarStates
+
+ Err err ->
+ Dict.insert key (SimilarError (httpErrorToString err)) model.similarStates
+ in
+ ( { model | similarStates = newStates }, 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
diff --git a/src/Templates.purs b/src/Templates.purs
@@ -743,12 +743,7 @@ indexHtml userSlug allUsers =
<>
""";
var app = Elm.Client.init({
- node: document.getElementById('app'),
- flags: { search: window.location.search, userSlug: userSlug, allUsers: allUsers }
- });
- app.ports.pushUrl.subscribe(function(url) {
- var prefix = userSlug ? '/u/' + userSlug : '';
- history.pushState({}, '', prefix + url);
+ flags: { userSlug: userSlug, allUsers: allUsers }
});
</script>
</body>
diff --git a/src/Types.elm b/src/Types.elm
@@ -0,0 +1,149 @@
+module Types exposing (ActiveFilter, Flags, Listen, Model, Msg(..), Period(..), SimilarState(..), SimilarTrack, Stats, StatsEntry, Tab(..), UserInfo)
+
+import Browser
+import Browser.Navigation as Nav
+import Dict exposing (Dict)
+import Http
+import Set exposing (Set)
+import Time
+import Url
+
+
+type alias UserInfo =
+ { slug : String
+ , name : String
+ }
+
+
+type alias Flags =
+ { userSlug : String
+ , allUsers : List UserInfo
+ }
+
+
+
+-- TYPES
+
+
+type Tab
+ = ListensTab
+ | StatsTab
+ | AboutTab
+
+
+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
+ , label : 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
+ }
+
+
+type alias SimilarTrack =
+ { artist : String
+ , track : String
+ , score : Maybe Float
+ , videoUri : Maybe String
+ }
+
+
+type SimilarState
+ = SimilarLoading
+ | SimilarLoaded (List SimilarTrack)
+ | SimilarError String
+
+
+
+-- MODEL
+
+
+type alias Model =
+ { navKey : Nav.Key
+ , listens : List Listen
+ , stats : Maybe Stats
+ , 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
+ , userSlug : String
+ , similarStates : Dict String SimilarState
+ , allUsers : List UserInfo
+ , searchInput : String
+ , activeSearch : Maybe String
+ }
+
+
+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
+ | FetchSimilar String String
+ | FetchSimilarTracks String String (Result Http.Error (List SimilarTrack))
+ | UpdateSearchInput String
+ | SubmitSearch
+ | ClearSearch
+ | UrlRequested Browser.UrlRequest
+ | UrlChanged Url.Url
+
+
+
+-- UPDATE
diff --git a/src/View.elm b/src/View.elm
@@ -0,0 +1,700 @@
+module View exposing (view)
+
+import Browser
+import Dict exposing (Dict)
+import Html exposing (Html, a, button, div, h1, h2, img, input, li, p, span, strong, text, ul)
+import Html.Attributes as Attr exposing (class, disabled, href, placeholder, src, style, target, type_, value)
+import Html.Events exposing (on, onClick, onInput)
+import Json.Decode as D
+import Set exposing (Set)
+import Time
+import Types exposing (Listen, Model, Msg(..), Period(..), SimilarState(..), SimilarTrack, Stats, StatsEntry, Tab(..), UserInfo)
+import Url
+
+
+
+-- VIEW
+
+
+view : Model -> Browser.Document Msg
+view model =
+ { title = "scrobbler"
+ , body =
+ [ div [ class "container" ]
+ [ h1 [] [ text "scrobbler" ]
+ , div [ class "tabs" ]
+ [ a
+ [ class
+ ("tab-btn"
+ ++ (if model.activeTab == ListensTab then
+ " active"
+
+ else
+ ""
+ )
+ )
+ , href
+ (if model.userSlug == "" then
+ "/"
+
+ else
+ "/u/" ++ model.userSlug
+ )
+ ]
+ [ text "listens" ]
+ , button
+ [ class
+ ("tab-btn"
+ ++ (if model.activeTab == StatsTab then
+ " active"
+
+ else
+ ""
+ )
+ )
+ , onClick (SwitchTab StatsTab)
+ ]
+ [ text "stats" ]
+ , button
+ [ class
+ ("tab-btn"
+ ++ (if model.activeTab == AboutTab then
+ " active"
+
+ else
+ ""
+ )
+ )
+ , onClick (SwitchTab AboutTab)
+ ]
+ [ text "about" ]
+ ]
+ , case model.activeTab of
+ ListensTab ->
+ div []
+ [ div [ class "search-bar" ]
+ [ input
+ [ type_ "text"
+ , class "search-input"
+ , placeholder "search by track, artist, album or label"
+ , value model.searchInput
+ , onInput UpdateSearchInput
+ , onEnter SubmitSearch
+ ]
+ []
+ , button [ class "search-btn", onClick SubmitSearch ] [ text "search" ]
+ , case model.activeSearch of
+ Just _ ->
+ button [ class "filter-clear", onClick ClearSearch ] [ text "✕ clear" ]
+
+ Nothing ->
+ text ""
+ ]
+ , 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
+ ]
+
+ AboutTab ->
+ renderAboutView model.userSlug model.allUsers
+ ]
+ ]
+ }
+
+
+renderContent : Model -> Html Msg
+renderContent model =
+ if model.loading && List.isEmpty model.listens then
+ ul [] [ li [ class "loading" ] [ text "⏳" ] ]
+
+ else
+ case model.error of
+ Just err ->
+ ul [] [ li [ class "error" ] [ text err ] ]
+
+ Nothing ->
+ div [ class "tracks-with-similar" ]
+ (List.indexedMap
+ (\idx listen ->
+ let
+ artist =
+ Maybe.withDefault "" listen.artistName
+
+ trackName =
+ Maybe.withDefault "" listen.trackName
+
+ key =
+ artist ++ "\t" ++ trackName
+ in
+ div [ class "track-with-similar-container" ]
+ [ ul [ class "track-item" ]
+ [ renderListen model.userSlug model.currentTime model.failedCovers model.hoveredCover model.similarStates idx listen ]
+ , renderSimilarPanel model.similarStates key
+ ]
+ )
+ model.listens
+ )
+
+
+renderListen : String -> Maybe Time.Posix -> Set String -> Maybe Int -> Dict String SimilarState -> Int -> Listen -> Html Msg
+renderListen userSlug currentTime failedCovers hoveredCover similarStates idx listen =
+ let
+ artist =
+ Maybe.withDefault "" listen.artistName
+
+ trackName =
+ Maybe.withDefault "" listen.trackName
+
+ release =
+ Maybe.withDefault "" listen.releaseName
+
+ key =
+ artist ++ "\t" ++ trackName
+
+ mbid =
+ case listen.caaReleaseMbid of
+ Just m ->
+ Just m
+
+ Nothing ->
+ listen.releaseMbid
+
+ coverUrl =
+ "/cover?user="
+ ++ userSlug
+ ++ "&artist="
+ ++ Url.percentEncode artist
+ ++ "&release="
+ ++ Url.percentEncode release
+ ++ (case mbid of
+ Just m ->
+ "&mbid=" ++ m
+
+ Nothing ->
+ ""
+ )
+
+ isZoomed =
+ hoveredCover == Just idx
+
+ isActive =
+ Dict.member key similarStates
+ in
+ li [ class "success" ]
+ [ div [ class "track-info" ]
+ [ div [ class "track-name" ]
+ [ button [ class "track-link", onClick (FilterBy "track" (Maybe.withDefault "Unknown Track" listen.trackName)) ] [ text (Maybe.withDefault "Unknown Track" listen.trackName) ] ]
+ , div [ class "track-artist" ] [ button [ class "artist-link", onClick (FilterBy "artist" artist) ] [ text artist ] ]
+ , div [ class "track-time" ]
+ [ span []
+ (button [ class "album-link", onClick (FilterBy "album" release) ] [ text release ]
+ :: (case listen.label of
+ Just l ->
+ [ text " • "
+ , button [ class "label-link", onClick (FilterBy "label" l) ] [ text l ]
+ ]
+
+ Nothing ->
+ []
+ )
+ ++ [ 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 ""
+ , if artist /= "" && trackName /= "" then
+ button
+ [ class
+ ("similar-btn"
+ ++ (if isActive then
+ " active"
+
+ else
+ ""
+ )
+ )
+ , onClick (FetchSimilar artist trackName)
+ ]
+ [ text "similar" ]
+
+ else
+ text ""
+ ]
+ ]
+
+
+renderSimilarPanel : Dict String SimilarState -> String -> Html Msg
+renderSimilarPanel similarStates key =
+ case Dict.get key similarStates of
+ Nothing ->
+ text ""
+
+ Just SimilarLoading ->
+ div [ class "similar-panel" ]
+ [ div [ class "similar-loading" ] [ text "⏳" ] ]
+
+ Just (SimilarError err) ->
+ div [ class "similar-panel" ]
+ [ div [ class "similar-error" ] [ text err ] ]
+
+ Just (SimilarLoaded tracks) ->
+ div [ class "similar-panel" ]
+ [ if List.isEmpty tracks then
+ div [ class "similar-empty" ] [ text "no similar songs found" ]
+
+ else
+ div [] (List.map renderSimilarTrack tracks)
+ ]
+
+
+renderSimilarTrack : SimilarTrack -> Html Msg
+renderSimilarTrack track =
+ div [ class "similar-track" ]
+ [ div [ class "similar-track-info" ]
+ [ div [ class "similar-track-name" ] [ text track.track ]
+ , div [ class "similar-track-artist" ] [ text track.artist ]
+ ]
+ , case track.score of
+ Just score ->
+ span [ class "similar-score" ]
+ [ text (String.fromInt (round (score * 100)) ++ "%") ]
+
+ Nothing ->
+ text ""
+ , case track.videoUri of
+ Just link ->
+ a [ class "similar-link", href link, target "_blank" ]
+ [ text "▶" ]
+
+ Nothing ->
+ text ""
+ ]
+
+
+renderStatsView : Set String -> Set String -> Maybe Stats -> Html Msg
+renderStatsView expandedSections loadedSections mStats =
+ case mStats of
+ Nothing ->
+ div [ class "loading" ] [ text "⏳" ]
+
+ 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 "beyond here lies nothing" ]
+
+ 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 ""
+ ]
+
+
+onEnter : msg -> Html.Attribute msg
+onEnter msg =
+ on "keydown"
+ (D.field "key" D.string
+ |> D.andThen
+ (\key ->
+ if key == "Enter" then
+ D.succeed msg
+
+ else
+ D.fail "not enter"
+ )
+ )
+
+
+
+-- 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"
+
+
+renderAboutView : String -> List UserInfo -> Html Msg
+renderAboutView currentSlug allUsers =
+ let
+ otherUsers =
+ List.filter (\u -> u.slug /= currentSlug) allUsers
+
+ userLink { slug, name } =
+ let
+ url =
+ if slug == "" then
+ "/"
+
+ else
+ "/u/" ++ slug
+ in
+ li [] [ a [ href url ] [ text name ] ]
+
+ extLink url label =
+ a [ href url, target "_blank", class "about-link" ] [ text label ]
+ in
+ div []
+ [ p [ class "about-lead" ]
+ [ text "corpus is a self-hosted listen history proxy that syncs scrobbles from "
+ , extLink "https://listenbrainz.org" "ListenBrainz"
+ , text " and "
+ , extLink "https://www.last.fm" "Last.fm."
+ ]
+ , div [ class "stats-section" ]
+ [ h2 [] [ text "features" ]
+ , ul [ class "about-list" ]
+ [ li [] [ text "searchable listen history with pagination" ]
+ , li [] [ text "stats by artist, track, label, year, and genre" ]
+ , li [] [ text "filter listens by label, artist, genre, or year" ]
+ , li [] [ text "cover art from Cover Art Archive, Last.fm, and Discogs" ]
+ , li [] [ text "similar track discovery via cosine.club" ]
+ , li [] [ text "metadata enrichment via MusicBrainz, Last.fm, and Discogs" ]
+ ]
+ ]
+ , div [ class "stats-section" ]
+ [ h2 [] [ text "links" ]
+ , p [ class "about-meta" ]
+ [ div [] [ extLink "https://instagram.com/counterpoint303" "counterpoint" ]
+ , div [] [ extLink "https://github.com/mtmn/corpus" "github repo" ]
+ , div [] [ extLink "https://mtmn.name" "mtmn.name" ]
+ ]
+ ]
+ , if List.isEmpty otherUsers then
+ text ""
+
+ else
+ div [ class "stats-section" ]
+ [ h2 [] [ text "friends" ]
+ , ul [ class "about-users" ]
+ (List.map userLink otherUsers)
+ ]
+ ]