commit 9545793c8ad0f7333c5205293a4488cfa9333104
parent c30098bccb7d0e7ba0a8b67a7577e9ca1d863058
Author: mtmn <miro@haravara.org>
Date: Fri, 17 Apr 2026 13:18:54 +0200
feat: use elm in frontend instead of halogen
Diffstat:
10 files changed, 1054 insertions(+), 933 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -1,5 +1,6 @@
bower_components/
node_modules/
+elm-stuff/
.pulp-cache/
output/
output-es/
diff --git a/docs/architecture.md b/docs/architecture.md
@@ -13,7 +13,7 @@ The server is built with PureScript running on Node.js. It handles several core
- **Cover Art Proxy**: A specialized endpoint that fetches, caches, and serves cover art, utilizing a multi-source fallback strategy (CAA → Last.fm → Discogs).
### Frontend
-A Single Page Application (SPA) built with PureScript and the [Halogen](https://github.com/purescript-halogen/purescript-halogen) framework.
+A Single Page Application (SPA) built with [Elm](https://elm-lang.org).
- **Real-time Updates**: Periodically refreshes the scrobble list.
- **Filtering & Search**: Supports deep filtering by genre, label, or release year.
- **Responsive UI**: Designed for both desktop and mobile viewing with a "retro-modern" aesthetic.
@@ -64,11 +64,10 @@ When a cover is requested:
## Tech Stack
-- **Language**: [PureScript](https://purescript.org)
-- **Frontend Framework**: [Halogen](https://github.com/purescript-halogen/purescript-halogen)
+- **Language**: [PureScript](https://purescript.org) (server), [Elm](https://elm-lang.org) (frontend)
- **Runtime**: [Node.js](https://nodejs.org)
- **Database**: [DuckDB](https://duckdb.org)
-- **Bundling**: [spago](https://github.com/purescript/spago) and [esbuild](https://esbuild.github.io/)
+- **Bundling**: [spago](https://github.com/purescript/spago) + [esbuild](https://esbuild.github.io/) (server), [elm make](https://guide.elm-lang.org/install/elm.html) (frontend)
- **Environment**: [Nix](https://nixos.org) for reproducible development shells and container builds
## Foreign Function Interface (FFI)
@@ -105,7 +104,7 @@ graph TD
end
subgraph Frontend
- UI[Halogen SPA]
+ UI[Elm SPA]
end
%% Scrobble Sync Flow
diff --git a/elm.json b/elm.json
@@ -0,0 +1,25 @@
+{
+ "type": "application",
+ "source-directories": ["src"],
+ "elm-version": "0.19.1",
+ "dependencies": {
+ "direct": {
+ "elm/browser": "1.0.2",
+ "elm/core": "1.0.5",
+ "elm/html": "1.0.0",
+ "elm/http": "2.0.0",
+ "elm/json": "1.1.3",
+ "elm/time": "1.0.0",
+ "elm/url": "1.0.0"
+ },
+ "indirect": {
+ "elm/bytes": "1.0.8",
+ "elm/file": "1.0.5",
+ "elm/virtual-dom": "1.0.3"
+ }
+ },
+ "test-dependencies": {
+ "direct": {},
+ "indirect": {}
+ }
+}
diff --git a/package.json b/package.json
@@ -1,15 +1,16 @@
{
"name": "corpus",
"version": "1.0.0",
- "description": "ListenBrainz frontend in PureScript",
+ "description": "ListenBrainz scrobble viewer",
"main": "index.js",
"type": "module",
"scripts": {
- "build": "npx spago build && npx esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:duckdb --external:@aws-sdk/client-s3 && npx spago bundle --module Client --outfile client.js --platform browser",
+ "build": "npx spago build && npx esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:duckdb --external:@aws-sdk/client-s3 && elm make src/Client.elm --output=client.js",
"test": "npx spago test",
"tidy": "purs-tidy format-in-place src/**/*.purs"
},
"devDependencies": {
+ "elm": "^0.19.1",
"esbuild": "^0.28.0",
"purescript": "^0.15.16",
"purescript-language-server": "^0.18.0",
diff --git a/spago.lock b/spago.lock
@@ -7,8 +7,6 @@
"dependencies": [
"aff",
"aff-retry",
- "affjax",
- "affjax-web",
"argonaut",
"argonaut-core",
"arrays",
@@ -21,7 +19,6 @@
"fetch-argonaut",
"foreign-object",
"formatters",
- "halogen",
"http-methods",
"integers",
"js-uri",
@@ -36,13 +33,10 @@
"node-streams",
"node-url",
"now",
- "ordered-collections",
"prelude",
"strings",
"tailrec",
"unsafe-coerce",
- "web-dom",
- "web-html",
"web-url"
]
},
@@ -64,7 +58,7 @@
},
"package_set": {
"address": {
- "registry": "75.9.0"
+ "registry": "76.0.0"
},
"compiler": ">=0.15.15 <0.16.0",
"content": {
@@ -549,7 +543,7 @@
"systemd-journald": "0.3.0",
"tagged": "4.0.2",
"tailrec": "6.1.0",
- "tanstack-query": "2.0.1",
+ "tanstack-query": "3.0.0",
"tecton": "0.2.1",
"tecton-halogen": "0.2.0",
"temporal": "0.1.0",
@@ -691,7 +685,7 @@
"yoga-redis": "0.1.0",
"yoga-shadcn": "1.0.5",
"yoga-sql-types": "0.1.0",
- "yoga-sqlite": "0.3.0",
+ "yoga-sqlite": "0.3.2",
"yoga-sse": "0.1.1",
"yoga-subtlecrypto": "0.1.0",
"yoga-test-docker": "0.1.2",
@@ -747,48 +741,6 @@
"transformers"
]
},
- "affjax": {
- "type": "registry",
- "version": "13.0.0",
- "integrity": "sha256-dpOV8ELNqUVBwxE6eKFdnFky+sLwPFANrFUzIxQablk=",
- "dependencies": [
- "aff",
- "argonaut-core",
- "arraybuffer-types",
- "arrays",
- "control",
- "datetime",
- "either",
- "exceptions",
- "foldable-traversable",
- "foreign",
- "form-urlencoded",
- "functions",
- "http-methods",
- "lists",
- "maybe",
- "media-types",
- "newtype",
- "nullable",
- "prelude",
- "transformers",
- "web-dom",
- "web-file",
- "web-xhr"
- ]
- },
- "affjax-web": {
- "type": "registry",
- "version": "1.0.0",
- "integrity": "sha256-sHg+G50LDoZYG6UHvUiH1ZLT/UHIXaEF5DUBaPXxtxM=",
- "dependencies": [
- "aff",
- "affjax",
- "either",
- "maybe",
- "prelude"
- ]
- },
"ansi": {
"type": "registry",
"version": "7.0.0",
@@ -1016,23 +968,6 @@
"type-equality"
]
},
- "dom-indexed": {
- "type": "registry",
- "version": "13.0.0",
- "integrity": "sha256-Tr9uDQdmKN4TUGMg1/4KzsVu5zPa8OqKB4N6/S2a8vU=",
- "dependencies": [
- "datetime",
- "media-types",
- "prelude",
- "strings",
- "web-clipboard",
- "web-events",
- "web-html",
- "web-pointerevents",
- "web-touchevents",
- "web-uievents"
- ]
- },
"effect": {
"type": "registry",
"version": "4.0.0",
@@ -1202,20 +1137,6 @@
"transformers"
]
},
- "form-urlencoded": {
- "type": "registry",
- "version": "7.0.0",
- "integrity": "sha256-+8F0S6thSLsC1GfQiTdTt6jyTMuhsgKLciBUzde9aFU=",
- "dependencies": [
- "foldable-traversable",
- "js-uri",
- "maybe",
- "newtype",
- "prelude",
- "strings",
- "tuples"
- ]
- },
"formatters": {
"type": "registry",
"version": "7.0.0",
@@ -1263,23 +1184,6 @@
"unsafe-coerce"
]
},
- "freeap": {
- "type": "registry",
- "version": "7.0.0",
- "integrity": "sha256-e7SiV9rg+rVARsU9cxA/02sps7ubogvVgYwj8nWosX4=",
- "dependencies": [
- "const",
- "either",
- "gen",
- "lists",
- "newtype",
- "nonempty",
- "prelude",
- "tailrec",
- "tuples",
- "unsafe-coerce"
- ]
- },
"functions": {
"type": "registry",
"version": "6.0.0",
@@ -1325,92 +1229,6 @@
"unfoldable"
]
},
- "halogen": {
- "type": "registry",
- "version": "7.0.0",
- "integrity": "sha256-YrUm27QEiE1DyGaGJ5MNLVg4H/P3gnX/NVv1gRtWjB4=",
- "dependencies": [
- "aff",
- "bifunctors",
- "console",
- "control",
- "dom-indexed",
- "effect",
- "either",
- "exceptions",
- "foldable-traversable",
- "foreign",
- "fork",
- "free",
- "freeap",
- "functions",
- "halogen-subscriptions",
- "halogen-vdom",
- "lazy",
- "lists",
- "maybe",
- "media-types",
- "newtype",
- "ordered-collections",
- "parallel",
- "prelude",
- "profunctor",
- "refs",
- "strings",
- "tailrec",
- "transformers",
- "tuples",
- "unfoldable",
- "unsafe-coerce",
- "unsafe-reference",
- "web-clipboard",
- "web-dom",
- "web-events",
- "web-file",
- "web-html",
- "web-touchevents",
- "web-uievents"
- ]
- },
- "halogen-subscriptions": {
- "type": "registry",
- "version": "2.0.0",
- "integrity": "sha256-1eBtVZENgGtKuOY9H0iuYD3dO1CSqmOIyhYe4OhypOU=",
- "dependencies": [
- "arrays",
- "contravariant",
- "control",
- "effect",
- "foldable-traversable",
- "maybe",
- "prelude",
- "refs",
- "safe-coerce",
- "unsafe-reference"
- ]
- },
- "halogen-vdom": {
- "type": "registry",
- "version": "8.0.0",
- "integrity": "sha256-jk6aj/tH630skFVk6mB5Q+0g2zb897KX72T63fJhJ2Y=",
- "dependencies": [
- "arrays",
- "bifunctors",
- "effect",
- "foreign",
- "foreign-object",
- "functions",
- "maybe",
- "newtype",
- "nullable",
- "prelude",
- "refs",
- "tuples",
- "unsafe-coerce",
- "web-dom",
- "web-events"
- ]
- },
"http-methods": {
"type": "registry",
"version": "6.0.0",
@@ -2289,45 +2107,6 @@
"integrity": "sha256-0L1QsaY20OILjfU5TV72d3U/tSjhmL9hJ32WMp857Lk=",
"dependencies": []
},
- "unsafe-reference": {
- "type": "registry",
- "version": "5.0.0",
- "integrity": "sha256-ttSJTQUnK8AK2eGOsfRxLUJEDPL6pnmExjbiOqfwC6I=",
- "dependencies": [
- "prelude"
- ]
- },
- "web-clipboard": {
- "type": "registry",
- "version": "6.0.0",
- "integrity": "sha256-3CV0txwKddLoj8qBrRjUWbiX0M8+rnOpi1iApr5PEb0=",
- "dependencies": [
- "effect",
- "functions",
- "js-promise",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events",
- "web-html"
- ]
- },
- "web-dom": {
- "type": "registry",
- "version": "6.0.0",
- "integrity": "sha256-rVeqkxChkjqisDvOujy9BMEgGqJkwX3t6g21bXfiG5o=",
- "dependencies": [
- "effect",
- "enums",
- "maybe",
- "newtype",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events"
- ]
- },
"web-events": {
"type": "registry",
"version": "4.0.0",
@@ -2367,56 +2146,6 @@
"web-events"
]
},
- "web-html": {
- "type": "registry",
- "version": "4.1.1",
- "integrity": "sha256-yOuZJGUxFrivHKpo/jKuKzFZaq6PPPE64ftSysXFssk=",
- "dependencies": [
- "effect",
- "enums",
- "foreign",
- "functions",
- "js-date",
- "maybe",
- "media-types",
- "newtype",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-dom",
- "web-events",
- "web-file",
- "web-storage"
- ]
- },
- "web-pointerevents": {
- "type": "registry",
- "version": "2.0.0",
- "integrity": "sha256-mQbm1V36u3It2WdYMAXtzLBJl3uRAhN4BjeZTw3LWN8=",
- "dependencies": [
- "effect",
- "maybe",
- "prelude",
- "unsafe-coerce",
- "web-dom",
- "web-events",
- "web-html",
- "web-uievents"
- ]
- },
- "web-storage": {
- "type": "registry",
- "version": "5.0.0",
- "integrity": "sha256-YJfos55oeKtBStNfoWfeflSy8j+4IDym5eaZtIY7YM4=",
- "dependencies": [
- "effect",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events"
- ]
- },
"web-streams": {
"type": "registry",
"version": "4.0.0",
@@ -2432,35 +2161,6 @@
"tuples"
]
},
- "web-touchevents": {
- "type": "registry",
- "version": "4.0.0",
- "integrity": "sha256-H02c53BJlHDlAgogj/x8bM7PagJjhMMrMPYy9I7Rf0s=",
- "dependencies": [
- "functions",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events",
- "web-uievents"
- ]
- },
- "web-uievents": {
- "type": "registry",
- "version": "5.0.0",
- "integrity": "sha256-yh9uVLIGu8wE1+jwLehtfsRfR1eyiShhIMMhBPqKybE=",
- "dependencies": [
- "effect",
- "enums",
- "maybe",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-events",
- "web-html"
- ]
- },
"web-url": {
"type": "registry",
"version": "2.0.0",
@@ -2471,30 +2171,6 @@
"prelude",
"tuples"
]
- },
- "web-xhr": {
- "type": "registry",
- "version": "5.0.1",
- "integrity": "sha256-gxQgeGwvF/NyGdw0FJ9IzXI3gqIMNb8oQO8X+p5jDyw=",
- "dependencies": [
- "arraybuffer-types",
- "datetime",
- "effect",
- "either",
- "enums",
- "foreign",
- "http-methods",
- "maybe",
- "media-types",
- "newtype",
- "nullable",
- "prelude",
- "unsafe-coerce",
- "web-dom",
- "web-events",
- "web-file",
- "web-html"
- ]
}
}
}
diff --git a/spago.yaml b/spago.yaml
@@ -2,8 +2,7 @@ package:
name: corpus
dependencies:
- aff
- - affjax
- - affjax-web
+ - aff-retry
- argonaut
- argonaut-core
- arrays
@@ -16,7 +15,6 @@ package:
- fetch-argonaut
- foreign-object
- formatters
- - halogen
- http-methods
- integers
- js-uri
@@ -31,14 +29,10 @@ package:
- node-streams
- node-url
- now
- - ordered-collections
- - aff-retry
- prelude
- strings
- tailrec
- unsafe-coerce
- - web-dom
- - web-html
- web-url
test:
main: Test.Main
@@ -55,5 +49,5 @@ package:
- node-process
workspace:
packageSet:
- registry: 75.9.0
+ registry: 76.0.0
extraPackages: {}
diff --git a/src/Client.elm b/src/Client.elm
@@ -0,0 +1,1007 @@
+port module Client exposing (main)
+
+import Browser
+import Html exposing (..)
+import Html.Attributes as Attr exposing (class, disabled, href, placeholder, src, style, target, type_, value)
+import Html.Events exposing (onClick, on, onInput)
+import Http
+import Json.Decode as D exposing (Decoder)
+import List
+import Maybe
+import Set exposing (Set)
+import String
+import Task
+import Time
+import Url
+
+
+port pushUrl : String -> Cmd msg
+
+
+main : Program String Model Msg
+main =
+ Browser.element
+ { init = init
+ , update = update
+ , view = view
+ , subscriptions = subscriptions
+ }
+
+
+-- TYPES
+
+
+type Tab
+ = ListensTab
+ | StatsTab
+
+
+type Period
+ = AllTime
+ | LastDays Int
+ | CustomRange String String
+
+
+type alias ActiveFilter =
+ { field : String
+ , value : String
+ }
+
+
+type alias Listen =
+ { trackName : Maybe String
+ , artistName : Maybe String
+ , releaseName : Maybe String
+ , listenedAt : Maybe Int
+ , genre : Maybe String
+ , releaseMbid : Maybe String
+ , caaReleaseMbid : Maybe String
+ }
+
+
+type alias StatsEntry =
+ { name : String
+ , count : Int
+ }
+
+
+type alias Stats =
+ { genres : List StatsEntry
+ , labels : List StatsEntry
+ , years : List StatsEntry
+ , artists : List StatsEntry
+ , tracks : List StatsEntry
+ }
+
+
+-- MODEL
+
+
+type alias Model =
+ { listens : List Listen
+ , stats : Maybe Stats
+ , lastCheck : Maybe Time.Posix
+ , error : Maybe String
+ , loading : Bool
+ , currentTime : Maybe Time.Posix
+ , failedCovers : Set String
+ , hoveredCover : Maybe Int
+ , expandedSections : Set String
+ , loadedSections : Set String
+ , offset : Int
+ , limit : Int
+ , activeTab : Tab
+ , activeFilter : Maybe ActiveFilter
+ , statsPeriod : Period
+ , customInput : String
+ , showCustomInput : Bool
+ , customError : Maybe String
+ }
+
+
+init : String -> ( Model, Cmd Msg )
+init searchString =
+ let
+ page =
+ parsePageParam searchString
+
+ offset =
+ max 0 ((page - 1) * 25)
+ in
+ ( { listens = []
+ , stats = Nothing
+ , lastCheck = Nothing
+ , error = Nothing
+ , loading = True
+ , currentTime = Nothing
+ , failedCovers = Set.empty
+ , hoveredCover = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , offset = offset
+ , limit = 25
+ , activeTab = ListensTab
+ , activeFilter = Nothing
+ , statsPeriod = AllTime
+ , customInput = ""
+ , showCustomInput = False
+ , customError = Nothing
+ }
+ , Cmd.batch
+ [ fetchListens 25 offset Nothing
+ , Task.perform GotTime Time.now
+ ]
+ )
+
+
+parsePageParam : String -> Int
+parsePageParam search =
+ let
+ s =
+ if String.startsWith "?" search then
+ String.dropLeft 1 search
+
+ else
+ search
+ in
+ s
+ |> String.split "&"
+ |> List.filterMap
+ (\pair ->
+ case String.split "=" pair of
+ [ "page", v ] ->
+ String.toInt v
+
+ _ ->
+ Nothing
+ )
+ |> List.head
+ |> Maybe.withDefault 1
+
+
+-- MSG
+
+
+type Msg
+ = GotListens (Result Http.Error (List Listen))
+ | GotStats (Result Http.Error Stats)
+ | GotSectionData String (Result Http.Error (List StatsEntry))
+ | Tick Time.Posix
+ | GotTime Time.Posix
+ | ImageError String
+ | NextPage
+ | PrevPage
+ | SwitchTab Tab
+ | SetStatsPeriod Period
+ | OpenCustomInput
+ | UpdateCustomInput String
+ | ApplyCustomPeriod
+ | FilterBy String String
+ | ClearFilter
+ | HoverCover Int
+ | UnhoverCover
+ | ExpandSection String
+ | ShowAllSection String
+ | CollapseSection String
+
+
+-- UPDATE
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+ case msg of
+ Tick time ->
+ if not model.loading then
+ ( { model | currentTime = Just time, loading = True }
+ , fetchListens model.limit model.offset model.activeFilter
+ )
+
+ else
+ ( { model | currentTime = Just time }, Cmd.none )
+
+ GotTime time ->
+ ( { model | lastCheck = Just time, currentTime = Just time }, Cmd.none )
+
+ GotListens result ->
+ let
+ newModel =
+ case result of
+ Err err ->
+ { model | loading = False, error = Just (httpErrorToString err) }
+
+ Ok listens ->
+ { model | loading = False, listens = listens, error = Nothing }
+ in
+ ( newModel, Task.perform GotTime Time.now )
+
+ GotStats result ->
+ case result of
+ Err err ->
+ ( { model | error = Just (httpErrorToString err) }, Cmd.none )
+
+ Ok stats ->
+ ( { model | stats = Just stats }, Cmd.none )
+
+ GotSectionData section result ->
+ case result of
+ Err err ->
+ ( { model | error = Just (httpErrorToString err) }, Cmd.none )
+
+ Ok entries ->
+ ( { model
+ | expandedSections = Set.insert section model.expandedSections
+ , loadedSections = Set.insert section model.loadedSections
+ , stats = Maybe.map (patchStatSection section entries) model.stats
+ }
+ , Cmd.none
+ )
+
+ ImageError url ->
+ ( { model | failedCovers = Set.insert url model.failedCovers }, Cmd.none )
+
+ NextPage ->
+ let
+ newOffset =
+ model.offset + model.limit
+
+ page =
+ newOffset // model.limit + 1
+ in
+ ( { model | offset = newOffset, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit newOffset model.activeFilter
+ , pushUrl ("?page=" ++ String.fromInt page)
+ ]
+ )
+
+ PrevPage ->
+ let
+ newOffset =
+ max 0 (model.offset - model.limit)
+
+ page =
+ newOffset // model.limit + 1
+ in
+ ( { model | offset = newOffset, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit newOffset model.activeFilter
+ , pushUrl ("?page=" ++ String.fromInt page)
+ ]
+ )
+
+ SwitchTab tab ->
+ ( { model | activeTab = tab }
+ , case tab of
+ StatsTab ->
+ if model.stats == Nothing then
+ fetchStats model.statsPeriod
+
+ else
+ Cmd.none
+
+ ListensTab ->
+ Cmd.none
+ )
+
+ SetStatsPeriod period ->
+ ( { model
+ | statsPeriod = period
+ , stats = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , showCustomInput = False
+ }
+ , fetchStats period
+ )
+
+ OpenCustomInput ->
+ let
+ prefill =
+ case model.statsPeriod of
+ CustomRange from to ->
+ from ++ " " ++ to
+
+ _ ->
+ model.customInput
+ in
+ ( { model | showCustomInput = True, customInput = prefill, customError = Nothing }
+ , Cmd.none
+ )
+
+ UpdateCustomInput str ->
+ ( { model | customInput = str, customError = Nothing }, Cmd.none )
+
+ ApplyCustomPeriod ->
+ let
+ parts =
+ model.customInput
+ |> String.split " "
+ |> List.filter (not << String.isEmpty)
+ in
+ case parts of
+ [ from, to ] ->
+ if String.length from /= 10 || String.length to /= 10 then
+ ( { model | customError = Just "Dates must be in YYYY-MM-DD format" }, Cmd.none )
+
+ else if from > to then
+ ( { model | customError = Just "'from' must be before 'to'" }, Cmd.none )
+
+ else
+ let
+ period =
+ CustomRange from to
+ in
+ ( { model
+ | statsPeriod = period
+ , stats = Nothing
+ , expandedSections = Set.empty
+ , loadedSections = Set.empty
+ , showCustomInput = False
+ , customError = Nothing
+ }
+ , fetchStats period
+ )
+
+ _ ->
+ ( { model | customError = Just "Enter two dates separated by a space" }, Cmd.none )
+
+ FilterBy field value ->
+ let
+ filter =
+ Just { field = field, value = value }
+ in
+ ( { model | activeFilter = filter, offset = 0, activeTab = ListensTab, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit 0 filter
+ , pushUrl "?page=1"
+ ]
+ )
+
+ ClearFilter ->
+ ( { model | activeFilter = Nothing, offset = 0, loading = True }
+ , Cmd.batch
+ [ fetchListens model.limit 0 Nothing
+ , pushUrl "?page=1"
+ ]
+ )
+
+ HoverCover idx ->
+ ( { model | hoveredCover = Just idx }, Cmd.none )
+
+ UnhoverCover ->
+ ( { model | hoveredCover = Nothing }, Cmd.none )
+
+ ExpandSection section ->
+ ( { model | expandedSections = Set.insert section model.expandedSections }, Cmd.none )
+
+ ShowAllSection section ->
+ ( model, fetchSectionData model.statsPeriod section )
+
+ CollapseSection section ->
+ ( { model
+ | expandedSections = Set.remove section model.expandedSections
+ , loadedSections = Set.remove section model.loadedSections
+ }
+ , Cmd.none
+ )
+
+
+patchStatSection : String -> List StatsEntry -> Stats -> Stats
+patchStatSection section entries stats =
+ case section of
+ "artist" ->
+ { stats | artists = entries }
+
+ "track" ->
+ { stats | tracks = entries }
+
+ "genre" ->
+ { stats | genres = entries }
+
+ "label" ->
+ { stats | labels = entries }
+
+ "year" ->
+ { stats | years = entries }
+
+ _ ->
+ stats
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions _ =
+ Time.every 30000 Tick
+
+
+-- HTTP
+
+
+fetchListens : Int -> Int -> Maybe ActiveFilter -> Cmd Msg
+fetchListens limit offset mFilter =
+ let
+ filterParams =
+ case mFilter of
+ Nothing ->
+ ""
+
+ Just { field, value } ->
+ "&filterField=" ++ field ++ "&filterValue=" ++ Url.percentEncode value
+
+ url =
+ "/proxy?limit=" ++ String.fromInt limit ++ "&offset=" ++ String.fromInt offset ++ filterParams
+ in
+ Http.get
+ { url = url
+ , expect = Http.expectJson GotListens listensDecoder
+ }
+
+
+fetchStats : Period -> Cmd Msg
+fetchStats period =
+ Http.get
+ { url = statsUrl period Nothing
+ , expect = Http.expectJson GotStats statsDecoder
+ }
+
+
+fetchSectionData : Period -> String -> Cmd Msg
+fetchSectionData period section =
+ Http.get
+ { url = statsUrl period (Just section)
+ , expect = Http.expectJson (GotSectionData section) (sectionEntriesDecoder section)
+ }
+
+
+statsUrl : Period -> Maybe String -> String
+statsUrl period mSection =
+ let
+ periodPart =
+ case period of
+ AllTime ->
+ ""
+
+ LastDays n ->
+ "period=" ++ String.fromInt n
+
+ CustomRange from to ->
+ "from=" ++ from ++ "&to=" ++ to
+
+ sectionPart =
+ case mSection of
+ Nothing ->
+ ""
+
+ Just sec ->
+ (if String.isEmpty periodPart then "" else "&") ++ "section=" ++ sec
+
+ query =
+ periodPart ++ sectionPart
+ in
+ "/stats" ++ (if String.isEmpty query then "" else "?" ++ query)
+
+
+httpErrorToString : Http.Error -> String
+httpErrorToString err =
+ case err of
+ Http.BadUrl url ->
+ "Bad URL: " ++ url
+
+ Http.Timeout ->
+ "Request timed out"
+
+ Http.NetworkError ->
+ "Network error"
+
+ Http.BadStatus status ->
+ "Server error: " ++ String.fromInt status
+
+ Http.BadBody body ->
+ "JSON decode error: " ++ body
+
+
+-- DECODERS
+
+
+listensDecoder : Decoder (List Listen)
+listensDecoder =
+ D.at [ "payload", "listens" ] (D.list listenDecoder)
+
+
+listenDecoder : Decoder Listen
+listenDecoder =
+ D.map2
+ (\meta listenedAt ->
+ { trackName = meta.trackName
+ , artistName = meta.artistName
+ , releaseName = meta.releaseName
+ , listenedAt = listenedAt
+ , genre = meta.genre
+ , releaseMbid = meta.releaseMbid
+ , caaReleaseMbid = meta.caaReleaseMbid
+ }
+ )
+ (D.field "track_metadata" trackMetaDecoder)
+ (D.maybe (D.field "listened_at" D.int))
+
+
+type alias TrackMeta =
+ { trackName : Maybe String
+ , artistName : Maybe String
+ , releaseName : Maybe String
+ , genre : Maybe String
+ , releaseMbid : Maybe String
+ , caaReleaseMbid : Maybe String
+ }
+
+
+trackMetaDecoder : Decoder TrackMeta
+trackMetaDecoder =
+ D.map6 TrackMeta
+ (D.maybe (D.field "track_name" D.string))
+ (D.maybe (D.field "artist_name" D.string))
+ (D.maybe (D.field "release_name" D.string))
+ (D.maybe (D.field "genre" D.string))
+ (D.maybe (D.at [ "mbid_mapping", "release_mbid" ] D.string))
+ (D.maybe (D.at [ "mbid_mapping", "caa_release_mbid" ] D.string))
+
+
+statsDecoder : Decoder Stats
+statsDecoder =
+ D.map5 Stats
+ (D.field "genres" (D.list entryDecoder))
+ (D.field "labels" (D.list entryDecoder))
+ (D.field "years" (D.list entryDecoder))
+ (D.field "artists" (D.list entryDecoder))
+ (D.field "tracks" (D.list entryDecoder))
+
+
+entryDecoder : Decoder StatsEntry
+entryDecoder =
+ D.map2 StatsEntry
+ (D.field "name" D.string)
+ (D.field "count" D.int)
+
+
+sectionEntriesDecoder : String -> Decoder (List StatsEntry)
+sectionEntriesDecoder section =
+ D.map
+ (\stats ->
+ case section of
+ "artist" ->
+ stats.artists
+
+ "track" ->
+ stats.tracks
+
+ "genre" ->
+ stats.genres
+
+ "label" ->
+ stats.labels
+
+ "year" ->
+ stats.years
+
+ _ ->
+ []
+ )
+ statsDecoder
+
+
+-- VIEW
+
+
+view : Model -> Html Msg
+view model =
+ div [ class "container" ]
+ [ h1 [] [ text "scrobbler" ]
+ , div [ class "tabs" ]
+ [ a
+ [ class ("tab-btn" ++ (if model.activeTab == ListensTab then " active" else ""))
+ , href "/"
+ ]
+ [ text "listens" ]
+ , button
+ [ class ("tab-btn" ++ (if model.activeTab == StatsTab then " active" else ""))
+ , onClick (SwitchTab StatsTab)
+ ]
+ [ text "stats" ]
+ ]
+ , case model.activeTab of
+ ListensTab ->
+ div []
+ [ case model.activeFilter of
+ Nothing ->
+ text ""
+
+ Just { field, value } ->
+ div [ class "filter-banner" ]
+ [ span [ class "filter-label" ]
+ [ text (field ++ ": ")
+ , strong [] [ text value ]
+ ]
+ , button [ class "filter-clear", onClick ClearFilter ]
+ [ text "✕ clear" ]
+ ]
+ , renderContent model
+ , div [ class "pagination" ]
+ [ button
+ [ class "page-btn"
+ , disabled (model.offset == 0 || model.loading)
+ , onClick PrevPage
+ ]
+ [ text "Previous" ]
+ , div [ class "page-indicator" ]
+ [ text ("Page " ++ String.fromInt (model.offset // model.limit + 1)) ]
+ , button
+ [ class "page-btn"
+ , disabled (List.length model.listens < model.limit || model.loading)
+ , onClick NextPage
+ ]
+ [ text "Next" ]
+ ]
+ ]
+
+ StatsTab ->
+ div []
+ [ renderPeriodSelector model.statsPeriod model.showCustomInput model.customInput model.customError
+ , renderStatsView model.expandedSections model.loadedSections model.stats
+ ]
+ , div [ Attr.id "footer", class "small" ]
+ [ span [] [ text (lastCheckText model.currentTime model.lastCheck) ] ]
+ ]
+
+
+renderContent : Model -> Html Msg
+renderContent model =
+ if model.loading && List.isEmpty model.listens then
+ ul [] [ li [ class "loading" ] [ text "Loading recent tracks..." ] ]
+
+ else
+ case model.error of
+ Just err ->
+ ul [] [ li [ class "error" ] [ text err ] ]
+
+ Nothing ->
+ ul [ Attr.id "tracks-container" ]
+ (List.indexedMap
+ (\idx listen ->
+ renderListen model.currentTime model.failedCovers model.hoveredCover idx listen
+ )
+ model.listens
+ )
+
+
+renderListen : Maybe Time.Posix -> Set String -> Maybe Int -> Int -> Listen -> Html Msg
+renderListen currentTime failedCovers hoveredCover idx listen =
+ let
+ artist =
+ Maybe.withDefault "" listen.artistName
+
+ release =
+ Maybe.withDefault "" listen.releaseName
+
+ mbid =
+ case listen.caaReleaseMbid of
+ Just m ->
+ Just m
+
+ Nothing ->
+ listen.releaseMbid
+
+ coverUrl =
+ "/cover?artist="
+ ++ Url.percentEncode artist
+ ++ "&release="
+ ++ Url.percentEncode release
+ ++ (case mbid of
+ Just m ->
+ "&mbid=" ++ m
+
+ Nothing ->
+ ""
+ )
+
+ isZoomed =
+ hoveredCover == Just idx
+ in
+ li [ class "success" ]
+ [ div [ class "track-info" ]
+ [ div [ class "track-name" ]
+ [ text (Maybe.withDefault "Unknown Track" listen.trackName) ]
+ , div [ class "track-artist" ] [ text artist ]
+ , div [ class "track-time" ]
+ [ span []
+ [ a
+ [ href ("https://www.discogs.com/search/?q=" ++ Url.percentEncode (artist ++ " " ++ release) ++ "&type=release")
+ , target "_blank"
+ , class "album-link"
+ ]
+ [ text release ]
+ , text (" • " ++ timeAgo currentTime listen.listenedAt)
+ ]
+ ]
+ ]
+ , div [ class "cover-wrapper" ]
+ [ if Set.member coverUrl failedCovers then
+ text ""
+
+ else
+ img
+ [ class ("track-cover" ++ (if isZoomed then " zoomed" else ""))
+ , src coverUrl
+ , Attr.alt release
+ , on "error" (D.succeed (ImageError coverUrl))
+ , onClick
+ (if isZoomed then
+ UnhoverCover
+
+ else
+ HoverCover idx
+ )
+ ]
+ []
+ , case listen.genre of
+ Just g ->
+ div [ class "genre-tag" ] [ text g ]
+
+ Nothing ->
+ text ""
+ ]
+ ]
+
+
+renderStatsView : Set String -> Set String -> Maybe Stats -> Html Msg
+renderStatsView expandedSections loadedSections mStats =
+ case mStats of
+ Nothing ->
+ div [ class "loading" ] [ text "Loading stats..." ]
+
+ Just stats ->
+ div []
+ [ renderStatSection expandedSections loadedSections (Just "artist") "top artists" stats.artists
+ , renderStatSection expandedSections loadedSections Nothing "top tracks" stats.tracks
+ , renderStatSection expandedSections loadedSections (Just "genre") "genres" stats.genres
+ , renderStatSection expandedSections loadedSections (Just "label") "labels" stats.labels
+ , renderStatSection expandedSections loadedSections (Just "year") "years" stats.years
+ ]
+
+
+renderStatSection : Set String -> Set String -> Maybe String -> String -> List StatsEntry -> Html Msg
+renderStatSection expandedSections loadedSections mField title entries =
+ let
+ sectionKey =
+ Maybe.withDefault title mField
+
+ expanded =
+ Set.member sectionKey expandedSections
+
+ loaded =
+ Set.member sectionKey loadedSections
+
+ visible =
+ if loaded then
+ entries
+
+ else if expanded then
+ List.take 50 entries
+
+ else
+ List.take 10 entries
+
+ maxCount =
+ entries
+ |> List.map .count
+ |> List.maximum
+ |> Maybe.withDefault 1
+
+ n =
+ List.length entries
+
+ footer =
+ if loaded then
+ if n > 10 then
+ button [ class "show-all-btn", onClick (CollapseSection sectionKey) ] [ text "show less" ]
+
+ else
+ text ""
+
+ else if expanded then
+ if n >= 50 then
+ span []
+ [ button [ class "show-all-btn", onClick (ShowAllSection sectionKey) ] [ text "show all" ]
+ , text " · "
+ , button [ class "show-all-btn", onClick (CollapseSection sectionKey) ] [ text "show less" ]
+ ]
+
+ else
+ button [ class "show-all-btn", onClick (CollapseSection sectionKey) ] [ text "show less" ]
+
+ else if n > 10 then
+ button [ class "show-all-btn", onClick (ExpandSection sectionKey) ] [ text "show more" ]
+
+ else
+ text ""
+ in
+ div [ class "stats-section" ]
+ [ h2 [] [ text title ]
+ , if List.isEmpty entries then
+ div [ class "stats-empty" ] [ text "no data yet — enrichment in progress" ]
+
+ else
+ ul [] (List.map (renderStatEntry maxCount mField) visible)
+ , footer
+ ]
+
+
+renderStatEntry : Int -> Maybe String -> StatsEntry -> Html Msg
+renderStatEntry maxCount mField entry =
+ let
+ barPct =
+ entry.count * 100 // maxCount
+
+ rowAttrs =
+ case mField of
+ Just field ->
+ [ class "stat-row clickable", onClick (FilterBy field entry.name) ]
+
+ Nothing ->
+ [ class "stat-row" ]
+ in
+ li rowAttrs
+ [ div [ class "stat-bar", style "width" (String.fromInt barPct ++ "%") ] []
+ , span [ class "stat-name" ] [ text entry.name ]
+ , span [ class "stat-count" ] [ text (String.fromInt entry.count) ]
+ ]
+
+
+renderPeriodSelector : Period -> Bool -> String -> Maybe String -> Html Msg
+renderPeriodSelector current showInput customVal mError =
+ let
+ isCustom =
+ case current of
+ CustomRange _ _ ->
+ True
+
+ _ ->
+ False
+
+ namedBtn target label =
+ button
+ [ class ("period-btn" ++ (if current == target then " active" else ""))
+ , onClick (SetStatsPeriod target)
+ ]
+ [ text label ]
+
+ customBtn =
+ button
+ [ class ("period-btn" ++ (if isCustom then " active" else ""))
+ , onClick OpenCustomInput
+ ]
+ [ text "custom" ]
+
+ daysBtn n =
+ let
+ label =
+ case n of
+ 7 ->
+ "1w"
+
+ 14 ->
+ "2w"
+
+ 30 ->
+ "1m"
+
+ 90 ->
+ "3m"
+
+ 180 ->
+ "6m"
+
+ 365 ->
+ "1y"
+
+ _ ->
+ String.fromInt n ++ "d"
+ in
+ button
+ [ class ("period-btn" ++ (if current == LastDays n then " active" else ""))
+ , onClick (SetStatsPeriod (LastDays n))
+ ]
+ [ text label ]
+ in
+ div []
+ [ div [ class "period-selector" ]
+ ([ namedBtn AllTime "all time", customBtn ]
+ ++ List.map daysBtn [ 7, 14, 30, 90, 180, 365 ]
+ )
+ , if showInput || isCustom then
+ div []
+ [ div [ class "custom-range" ]
+ [ input
+ [ type_ "text"
+ , class ("custom-range-input" ++ (if mError /= Nothing then " error" else ""))
+ , placeholder "2023-01-01 2026-01-01"
+ , value customVal
+ , onInput UpdateCustomInput
+ ]
+ []
+ , button [ class "period-btn", onClick ApplyCustomPeriod ]
+ [ text "apply" ]
+ ]
+ , case mError of
+ Just err ->
+ div [ class "custom-range-error" ] [ text err ]
+
+ Nothing ->
+ text ""
+ ]
+
+ else
+ text ""
+ ]
+
+
+-- HELPERS
+
+
+timeAgo : Maybe Time.Posix -> Maybe Int -> String
+timeAgo mNow mTimestamp =
+ case ( mNow, mTimestamp ) of
+ ( Just now, Just ts ) ->
+ let
+ nowSecs =
+ Time.posixToMillis now // 1000
+
+ diff =
+ nowSecs - ts
+ in
+ if diff < 60 then
+ "just now"
+
+ else if diff < 3600 then
+ let
+ mins =
+ diff // 60
+ in
+ String.fromInt mins ++ " minute" ++ (if mins > 1 then "s" else "") ++ " ago"
+
+ else if diff < 86400 then
+ let
+ hours =
+ diff // 3600
+ in
+ String.fromInt hours ++ " hour" ++ (if hours > 1 then "s" else "") ++ " ago"
+
+ else
+ let
+ days =
+ diff // 86400
+ in
+ String.fromInt days ++ " day" ++ (if days > 1 then "s" else "") ++ " ago"
+
+ _ ->
+ "unknown time"
+
+
+lastCheckText : Maybe Time.Posix -> Maybe Time.Posix -> String
+lastCheckText mCurrent mLastCheck =
+ case ( mCurrent, mLastCheck ) of
+ ( Just current, Just lastCheck ) ->
+ let
+ diff =
+ (Time.posixToMillis current - Time.posixToMillis lastCheck) // 1000
+ in
+ if diff < 5 then
+ "just updated"
+
+ else
+ "last checked " ++ String.fromInt diff ++ "s ago"
+
+ _ ->
+ ""
diff --git a/src/Client.js b/src/Client.js
@@ -1,8 +0,0 @@
-export const extractParam = (key) => (search) => {
- const params = new URLSearchParams(search);
- return params.get(key);
-};
-
-export const formatRFC3339 = (instant) => {
- return new Date(instant).toISOString();
-};
diff --git a/src/Client.purs b/src/Client.purs
@@ -1,583 +0,0 @@
-module Client where
-
-import Prelude
-
-import Affjax.Web as AX
-import Affjax.ResponseFormat as ResponseFormat
-import Data.Argonaut (decodeJson)
-import Data.Array (mapWithIndex, length, take, filter)
-import Data.String (Pattern(..))
-import Data.String as Str
-import Data.Either (Either(..))
-import Data.Int (floor, fromString, toNumber)
-import Data.Foldable (maximum)
-import Data.Maybe (Maybe(..), fromMaybe)
-import Effect (Effect)
-import Effect.Aff (Aff, delay)
-import Effect.Aff.Class (class MonadAff)
-import Effect.Class (liftEffect)
-import Effect.Now (now)
-import Control.Monad.Rec.Class (forever)
-import Halogen as H
-import Halogen.Aff as HA
-import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Halogen.VDom.Driver (runUI)
-import JSURI (encodeURIComponent)
-import Web.DOM.ParentNode (QuerySelector(..))
-import Types (Listen(..), ListenBrainzResponse(..), TrackMetadata(..), Payload(..), MbidMapping(..), Stats(..), StatsEntry(..))
-import Data.Time.Duration (Milliseconds(..))
-import Data.DateTime.Instant (Instant, unInstant)
-import Data.Set (Set)
-import Data.Set as Set
-import Web.HTML (window)
-import Web.HTML.Window (location, history)
-import Web.HTML.Location (search)
-import Web.HTML.History (pushState, DocumentTitle(..), URL(..))
-import Foreign (unsafeToForeign)
-import Data.Nullable (Nullable, toMaybe)
-
-data Tab = ListensTab | StatsTab
-
-derive instance eqTab :: Eq Tab
-
-data Period = AllTime | LastDays Int | CustomRange String String
-
-derive instance eqPeriod :: Eq Period
-
-type ActiveFilter = { field :: String, value :: String }
-
-type State =
- { listens :: Array Listen
- , stats :: Maybe Stats
- , lastCheck :: Maybe String
- , error :: Maybe String
- , loading :: Boolean
- , currentTime :: Maybe Milliseconds
- , failedCovers :: Set String
- , hoveredCover :: Maybe Int
- , expandedSections :: Set String
- , loadedSections :: Set String
- , offset :: Int
- , limit :: Int
- , activeTab :: Tab
- , activeFilter :: Maybe ActiveFilter
- , statsPeriod :: Period
- , customInput :: String
- , showCustomInput :: Boolean
- , customError :: Maybe String
- }
-
-data Action
- = Initialize
- | Refresh
- | ReceiveResponse (Either String (Array Listen))
- | ReceiveStats (Either String Stats)
- | ImageError String
- | NextPage
- | PrevPage
- | SwitchTab Tab
- | SetStatsPeriod Period
- | OpenCustomInput
- | UpdateCustomInput String
- | ApplyCustomPeriod
- | FilterBy String String
- | ClearFilter
- | HoverCover Int
- | UnhoverCover
- | ExpandSection String
- | ShowAllSection String
- | CollapseSection String
- | ReceiveSectionData String (Either String (Array StatsEntry))
-
-component :: forall query input output m. MonadAff m => H.Component query input output m
-component =
- H.mkComponent
- { initialState
- , render
- , eval: H.mkEval $ H.defaultEval
- { handleAction = handleAction
- , initialize = Just Initialize
- }
- }
- where
- initialState _ =
- { listens: []
- , stats: Nothing
- , lastCheck: Nothing
- , error: Nothing
- , loading: true
- , currentTime: Nothing
- , failedCovers: Set.empty
- , hoveredCover: Nothing
- , expandedSections: Set.empty
- , loadedSections: Set.empty
- , offset: 0
- , limit: 25
- , activeTab: ListensTab
- , activeFilter: Nothing
- , statsPeriod: AllTime
- , customInput: ""
- , showCustomInput: false
- , customError: Nothing
- }
-
- render state =
- HH.div
- [ HP.class_ (H.ClassName "container") ]
- [ HH.h1_ [ HH.text "scrobbler" ]
- , HH.div
- [ HP.class_ (H.ClassName "tabs") ]
- [ HH.a
- [ HP.class_ (H.ClassName $ "tab-btn" <> if state.activeTab == ListensTab then " active" else "")
- , HP.href "/"
- ]
- [ HH.text "listens" ]
- , HH.button
- [ HP.class_ (H.ClassName $ "tab-btn" <> if state.activeTab == StatsTab then " active" else "")
- , HE.onClick \_ -> SwitchTab StatsTab
- ]
- [ HH.text "stats" ]
- ]
- , case state.activeTab of
- ListensTab ->
- HH.div_
- [ case state.activeFilter of
- Nothing -> HH.text ""
- Just { field, value } ->
- HH.div [ HP.class_ (H.ClassName "filter-banner") ]
- [ HH.span [ HP.class_ (H.ClassName "filter-label") ]
- [ HH.text $ field <> ": "
- , HH.strong_ [ HH.text value ]
- ]
- , HH.button
- [ HP.class_ (H.ClassName "filter-clear")
- , HE.onClick \_ -> ClearFilter
- ]
- [ HH.text "✕ clear" ]
- ]
- , renderContent state
- , HH.div
- [ HP.class_ (H.ClassName "pagination") ]
- [ HH.button
- [ HP.class_ (H.ClassName "page-btn")
- , HP.disabled (state.offset == 0 || state.loading)
- , HE.onClick \_ -> PrevPage
- ]
- [ HH.text "Previous" ]
- , HH.div [ HP.class_ (H.ClassName "page-indicator") ] [ HH.text $ "Page " <> show (state.offset / state.limit + 1) ]
- , HH.button
- [ HP.class_ (H.ClassName "page-btn")
- , HP.disabled (length state.listens < state.limit || state.loading)
- , HE.onClick \_ -> NextPage
- ]
- [ HH.text "Next" ]
- ]
- ]
- StatsTab ->
- HH.div_
- [ renderPeriodSelector state.statsPeriod state.showCustomInput state.customInput state.customError
- , renderStatsView state.expandedSections state.loadedSections state.stats
- ]
- , HH.div
- [ HP.id "footer"
- , HP.class_ (H.ClassName "small")
- ]
- [ HH.span_ [ HH.text $ fromMaybe "" state.lastCheck ]
- ]
- ]
-
- renderStatsView _ _ Nothing =
- HH.div [ HP.class_ (H.ClassName "loading") ] [ HH.text "Loading stats..." ]
- renderStatsView expandedSections loadedSections (Just (Stats { genres, labels, years, artists, tracks })) =
- HH.div_
- [ renderStatSection expandedSections loadedSections (Just "artist") "top artists" artists
- , renderStatSection expandedSections loadedSections Nothing "top tracks" tracks
- , renderStatSection expandedSections loadedSections (Just "genre") "genres" genres
- , renderStatSection expandedSections loadedSections (Just "label") "labels" labels
- , renderStatSection expandedSections loadedSections (Just "year") "years" years
- ]
-
- renderStatSection expandedSections loadedSections mField title entries =
- let
- sectionKey = fromMaybe title mField
- maxCount = fromMaybe 1 (maximum (map (\(StatsEntry e) -> e.count) entries))
- expanded = Set.member sectionKey expandedSections
- loaded = Set.member sectionKey loadedSections
- visible = if loaded then entries else if expanded then take 50 entries else take 10 entries
- btn action label =
- HH.button
- [ HP.class_ (H.ClassName "show-all-btn"), HE.onClick \_ -> action ]
- [ HH.text label ]
- footer =
- if loaded then
- if length entries > 10 then btn (CollapseSection sectionKey) "show less" else HH.text ""
- else if expanded then
- -- we have up to 50; show "show all" only if there might be more
- if length entries >= 50 then HH.span_ [ btn (ShowAllSection sectionKey) "show all", HH.text " · ", btn (CollapseSection sectionKey) "show less" ]
- else btn (CollapseSection sectionKey) "show less"
- else if length entries > 10 then btn (ExpandSection sectionKey) "show more"
- else HH.text ""
- in
- HH.div [ HP.class_ (H.ClassName "stats-section") ]
- [ HH.h2_ [ HH.text title ]
- , if entries == [] then
- HH.div [ HP.class_ (H.ClassName "stats-empty") ] [ HH.text "no data yet — enrichment in progress" ]
- else
- HH.ul_ (map (renderStatEntry maxCount mField) visible)
- , footer
- ]
-
- renderStatEntry maxCount mField (StatsEntry { name, count }) =
- let
- barPct = floor (toNumber count * 100.0 / toNumber maxCount)
- clickProps = case mField of
- Just field -> [ HE.onClick \_ -> FilterBy field name ]
- Nothing -> []
- in
- HH.li
- ([ HP.class_ (H.ClassName $ "stat-row" <> if mField /= Nothing then " clickable" else "") ] <> clickProps)
- [ HH.div
- [ HP.class_ (H.ClassName "stat-bar")
- , HP.style $ "width: " <> show barPct <> "%"
- ]
- []
- , HH.span [ HP.class_ (H.ClassName "stat-name") ] [ HH.text name ]
- , HH.span [ HP.class_ (H.ClassName "stat-count") ] [ HH.text $ show count ]
- ]
-
- renderPeriodSelector current showInput customVal mError =
- HH.div_
- [ HH.div
- [ HP.class_ (H.ClassName "period-selector") ]
- ( [ namedBtn AllTime "all time", customBtn ]
- <> map daysBtn [ 7, 14, 30, 90, 180, 365 ]
- )
- , if showInput || isCustom then
- HH.div_
- [ HH.div
- [ HP.class_ (H.ClassName "custom-range") ]
- [ HH.input
- [ HP.type_ HP.InputText
- , HP.class_ (H.ClassName $ "custom-range-input" <> if mError /= Nothing then " error" else "")
- , HP.placeholder "2023-01-01 2026-01-01"
- , HP.value customVal
- , HE.onValueInput UpdateCustomInput
- ]
- , HH.button
- [ HP.class_ (H.ClassName "period-btn")
- , HE.onClick \_ -> ApplyCustomPeriod
- ]
- [ HH.text "apply" ]
- ]
- , case mError of
- Just err -> HH.div [ HP.class_ (H.ClassName "custom-range-error") ] [ HH.text err ]
- Nothing -> HH.text ""
- ]
- else HH.text ""
- ]
- where
- isCustom = case current of
- CustomRange _ _ -> true
- _ -> false
- namedBtn target label =
- HH.button
- [ HP.class_ (H.ClassName $ "period-btn" <> if current == target then " active" else "")
- , HE.onClick \_ -> SetStatsPeriod target
- ]
- [ HH.text label ]
- customBtn =
- HH.button
- [ HP.class_ (H.ClassName $ "period-btn" <> if isCustom then " active" else "")
- , HE.onClick \_ -> OpenCustomInput
- ]
- [ HH.text "custom" ]
- daysBtn n =
- HH.button
- [ HP.class_ (H.ClassName $ "period-btn" <> if current == LastDays n then " active" else "")
- , HE.onClick \_ -> SetStatsPeriod (LastDays n)
- ]
- [ HH.text $ case n of
- 7 -> "1w"
- 14 -> "2w"
- 30 -> "1m"
- 90 -> "3m"
- 180 -> "6m"
- 365 -> "1y"
- _ -> show n <> "d"
- ]
-
- renderContent state
- | state.loading && state.listens == [] =
- HH.ul_ [ HH.li [ HP.class_ (H.ClassName "loading") ] [ HH.text "Loading recent tracks..." ] ]
- | Just err <- state.error =
- HH.ul_ [ HH.li [ HP.class_ (H.ClassName "error") ] [ HH.text err ] ]
- | otherwise =
- HH.ul [ HP.id "tracks-container" ]
- (mapWithIndex (renderListen state.currentTime state.failedCovers state.hoveredCover) state.listens)
-
- renderListen currentTime failedCovers hoveredCover idx (Listen { trackMetadata: TrackMetadata track, listenedAt }) =
- let
- release = fromMaybe "" track.releaseName
- artist = fromMaybe "" track.artistName
-
- mbid = case track.mbidMapping of
- Just (MbidMapping { caaReleaseMbid: Just m }) -> Just m
- Just (MbidMapping { releaseMbid: Just m }) -> Just m
- _ -> Nothing
-
- coverUrl = "/cover?artist=" <> (fromMaybe "" $ encodeURIComponent artist)
- <> "&release="
- <> (fromMaybe "" $ encodeURIComponent release)
- <>
- ( case mbid of
- Just m -> "&mbid=" <> m
- Nothing -> ""
- )
- in
- HH.li
- [ HP.class_ (H.ClassName "success") ]
- [ HH.div
- [ HP.class_ (H.ClassName "track-info") ]
- [ HH.div
- [ HP.class_ (H.ClassName "track-name") ]
- [ HH.text $ fromMaybe "Unknown Track" track.trackName ]
- , HH.div
- [ HP.class_ (H.ClassName "track-artist") ]
- [ HH.text artist ]
- , HH.div
- [ HP.class_ (H.ClassName "track-time") ]
- [ let
- query = fromMaybe "" $ encodeURIComponent (artist <> " " <> release)
- in
- HH.span_
- [ HH.a
- [ HP.href $ "https://www.discogs.com/search/?q=" <> query <> "&type=release"
- , HP.target "_blank"
- , HP.class_ (H.ClassName "album-link")
- ]
- [ HH.text release ]
- , HH.text $ " • " <> (fromMaybe "unknown time" $ formatTimeAgo currentTime listenedAt)
- ]
- ]
- ]
- , HH.div [ HP.class_ (H.ClassName "cover-wrapper") ]
- [ if Set.member coverUrl failedCovers then HH.text ""
- else HH.img
- [ HP.class_ (H.ClassName $ "track-cover" <> if hoveredCover == Just idx then " zoomed" else "")
- , HP.src coverUrl
- , HP.alt release
- , HE.onError \_ -> ImageError coverUrl
- , HE.onClick \_ -> if hoveredCover == Just idx then UnhoverCover else HoverCover idx
- ]
- , case track.genre of
- Just g -> HH.div [ HP.class_ (H.ClassName "genre-tag") ] [ HH.text g ]
- Nothing -> HH.text ""
- ]
- ]
-
- handleAction = case _ of
- Initialize -> do
- w <- liftEffect window
- loc <- liftEffect $ location w
- qs <- liftEffect $ search loc
- let pageParam = toMaybe $ extractParam "page" qs
- let initialPage = fromMaybe 1 (pageParam >>= fromString)
- let initialOffset = max 0 ((initialPage - 1) * 25)
-
- H.modify_ _ { offset = initialOffset }
-
- void $ H.fork $ forever (H.liftAff (delay (Milliseconds 30000.0)) *> handleAction Refresh)
- handleAction Refresh
- Refresh -> do
- state <- H.get
- H.modify_ _ { loading = true, error = Nothing }
- response <- H.liftAff $ fetchListens state.limit state.offset state.activeFilter
- handleAction (ReceiveResponse response)
- ReceiveResponse result -> do
- nowInstant <- liftEffect now
- let nowMs = unInstant nowInstant
- let nowStr = formatRFC3339 nowInstant
- case result of
- Left err -> H.modify_ _ { loading = false, error = Just err, lastCheck = Just nowStr, currentTime = Just nowMs }
- Right listens -> H.modify_ _ { loading = false, listens = listens, lastCheck = Just nowStr, currentTime = Just nowMs }
- ReceiveStats result -> case result of
- Left err -> H.modify_ _ { error = Just err }
- Right stats -> H.modify_ _ { stats = Just stats }
- FilterBy field value -> do
- H.modify_ _ { activeFilter = Just { field, value }, offset = 0, activeTab = ListensTab }
- updateUrl
- handleAction Refresh
- ClearFilter -> do
- H.modify_ _ { activeFilter = Nothing, offset = 0 }
- updateUrl
- handleAction Refresh
- SwitchTab tab -> do
- H.modify_ _ { activeTab = tab }
- case tab of
- StatsTab -> do
- state <- H.get
- when (state.stats == Nothing) do
- response <- H.liftAff $ fetchStats state.statsPeriod
- handleAction (ReceiveStats response)
- ListensTab -> pure unit
- SetStatsPeriod period -> do
- H.modify_ _ { statsPeriod = period, stats = Nothing, expandedSections = Set.empty, loadedSections = Set.empty, showCustomInput = false }
- response <- H.liftAff $ fetchStats period
- handleAction (ReceiveStats response)
- OpenCustomInput -> do
- state <- H.get
- let
- prefill = case state.statsPeriod of
- CustomRange from to -> from <> " " <> to
- _ -> state.customInput
- H.modify_ _ { showCustomInput = true, customInput = prefill, customError = Nothing }
- UpdateCustomInput str -> H.modify_ _ { customInput = str, customError = Nothing }
- ApplyCustomPeriod -> do
- state <- H.get
- let parts = filter (_ /= "") (Str.split (Pattern " ") state.customInput)
- case parts of
- [ from, to ]
- | Str.length from /= 10 || Str.length to /= 10 ->
- H.modify_ _ { customError = Just "Dates must be in YYYY-MM-DD format" }
- | from > to ->
- H.modify_ _ { customError = Just "'from' must be before 'to'" }
- | otherwise -> do
- let period = CustomRange from to
- H.modify_ _ { statsPeriod = period, stats = Nothing, expandedSections = Set.empty, loadedSections = Set.empty, showCustomInput = false, customError = Nothing }
- response <- H.liftAff $ fetchStats period
- handleAction (ReceiveStats response)
- _ -> H.modify_ _ { customError = Just "Enter two dates separated by a space" }
- ImageError url -> do
- H.modify_ \state -> state { failedCovers = Set.insert url state.failedCovers }
- NextPage -> do
- H.modify_ \state -> state { offset = state.offset + state.limit }
- updateUrl
- handleAction Refresh
- PrevPage -> do
- H.modify_ \state -> state { offset = max 0 (state.offset - state.limit) }
- updateUrl
- handleAction Refresh
- HoverCover url -> do
- H.modify_ _ { hoveredCover = Just url }
- UnhoverCover -> do
- H.modify_ _ { hoveredCover = Nothing }
- ExpandSection section ->
- H.modify_ \s -> s { expandedSections = Set.insert section s.expandedSections }
- ShowAllSection section -> do
- state <- H.get
- response <- H.liftAff $ fetchSectionData state.statsPeriod section
- handleAction (ReceiveSectionData section response)
-
- CollapseSection section ->
- H.modify_ \s -> s
- { expandedSections = Set.delete section s.expandedSections
- , loadedSections = Set.delete section s.loadedSections
- }
- ReceiveSectionData section result -> case result of
- Left err -> H.modify_ _ { error = Just err }
- Right entries -> H.modify_ \s -> s
- { expandedSections = Set.insert section s.expandedSections
- , loadedSections = Set.insert section s.loadedSections
- , stats = map (updateStatSection section entries) s.stats
- }
-
- updateUrl = do
- state <- H.get
- let page = (state.offset / state.limit) + 1
- liftEffect do
- w <- window
- h <- history w
- pushState (unsafeToForeign {}) (DocumentTitle "") (URL $ "?page=" <> show page) h
-
- fetchListens :: Int -> Int -> Maybe ActiveFilter -> Aff (Either String (Array Listen))
- fetchListens limit offset mFilter = do
- let
- filterParams = case mFilter of
- Nothing -> ""
- Just { field, value } -> "&filterField=" <> field <> "&filterValue=" <> (fromMaybe value (encodeURIComponent value))
- let url = "/proxy?limit=" <> show limit <> "&offset=" <> show offset <> filterParams
- res <- AX.get ResponseFormat.json url
- case res of
- Left err -> pure $ Left $ "Network error: " <> AX.printError err
- Right response ->
- case decodeJson response.body of
- Left err -> pure $ Left $ "JSON decode error: " <> show err
- Right (ListenBrainzResponse { payload: Payload { listens } }) -> pure $ Right listens
-
- updateStatSection section entries (Stats s) = Stats $ case section of
- "artist" -> s { artists = entries }
- "track" -> s { tracks = entries }
- "genre" -> s { genres = entries }
- "label" -> s { labels = entries }
- "year" -> s { years = entries }
- _ -> s
-
- statsUrl :: Period -> Maybe String -> String
- statsUrl period mSection =
- "/stats" <> case query of
- "" -> ""
- q -> "?" <> q
- where
- periodPart = case period of
- AllTime -> ""
- LastDays n -> "period=" <> show n
- CustomRange from to -> "from=" <> from <> "&to=" <> to
- sectionPart = case mSection of
- Nothing -> ""
- Just sec -> (if periodPart /= "" then "&" else "") <> "section=" <> sec
- query = periodPart <> sectionPart
-
- fetchSectionData :: Period -> String -> Aff (Either String (Array StatsEntry))
- fetchSectionData period section = do
- res <- AX.get ResponseFormat.json (statsUrl period (Just section))
- case res of
- Left err -> pure $ Left $ "Network error: " <> AX.printError err
- Right response ->
- case decodeJson response.body of
- Left err -> pure $ Left $ "JSON decode error: " <> show err
- Right (Stats s) -> pure $ Right $ case section of
- "artist" -> s.artists
- "track" -> s.tracks
- "genre" -> s.genres
- "label" -> s.labels
- "year" -> s.years
- _ -> []
-
- fetchStats :: Period -> Aff (Either String Stats)
- fetchStats period = do
- res <- AX.get ResponseFormat.json (statsUrl period Nothing)
- case res of
- Left err -> pure $ Left $ "Network error: " <> AX.printError err
- Right response ->
- case decodeJson response.body of
- Left err -> pure $ Left $ "JSON decode error: " <> show err
- Right stats -> pure $ Right stats
-
- formatTimeAgo :: Maybe Milliseconds -> Maybe Int -> Maybe String
- formatTimeAgo Nothing _ = Nothing
- formatTimeAgo _ Nothing = Nothing
- formatTimeAgo (Just (Milliseconds nowMs)) (Just timestamp) =
- let
- nowSecs = floor (nowMs / 1000.0)
- diff = nowSecs - timestamp
- in
- Just $
- if diff < 60 then "just now"
- else if diff < 3600 then
- let mins = diff / 60 in show mins <> " minute" <> (if mins > 1 then "s" else "") <> " ago"
- else if diff < 86400 then
- let hours = diff / 3600 in show hours <> " hour" <> (if hours > 1 then "s" else "") <> " ago"
- else
- let days = diff / 86400 in show days <> " day" <> (if days > 1 then "s" else "") <> " ago"
-
-main :: Effect Unit
-main = HA.runHalogenAff do
- maybeApp <- HA.selectElement (QuerySelector "#app")
- case maybeApp of
- Nothing -> HA.awaitBody >>= runUI component unit
- Just app -> runUI component unit app
-
-foreign import extractParam :: String -> String -> Nullable String
-foreign import formatRFC3339 :: Instant -> String
diff --git a/src/Main.purs b/src/Main.purs
@@ -760,6 +760,15 @@ indexHtml =
<body>
<div id="app"></div>
<script src="/client.js"></script>
+ <script>
+ var app = Elm.Client.init({
+ node: document.getElementById('app'),
+ flags: window.location.search
+ });
+ app.ports.pushUrl.subscribe(function(url) {
+ history.pushState({}, '', url);
+ });
+ </script>
</body>
</html>"""
