corpus

Log | Files | Refs | README | LICENSE

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:
Mpackage-lock.json | 522++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
Mpackage.json | 7++++---
Mspago.lock | 16++++++++++++++++
Mspago.yaml | 1+
Asrc/Api.elm | 209+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Msrc/Client.elm | 1415+------------------------------------------------------------------------------
Asrc/Image.js | 14++++++++++++++
Asrc/Image.purs | 12++++++++++++
Msrc/Main.purs | 26+++++++++++++++++---------
Asrc/State.elm | 502+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Msrc/Templates.purs | 7+------
Asrc/Types.elm | 149+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Asrc/View.elm | 700+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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 -> + "&section=" ++ 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 -> - "&section=" ++ 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) + ] + ]