commit 248edff954cb1d7e0f8d55b854b4426c9f24e560
parent d9bf40b8520765507c4c60d32717b22315c5f75a
Author: mtmn <miro@haravara.org>
Date: Wed, 15 Apr 2026 20:35:56 +0200
feat: add filters, allow show all
Diffstat:
6 files changed, 213 insertions(+), 66 deletions(-)
diff --git a/devenv.lock b/devenv.lock
@@ -3,11 +3,11 @@
"devenv": {
"locked": {
"dir": "src/modules",
- "lastModified": 1775997427,
- "narHash": "sha256-JUXHTRFoHQanKoAKvHTM4Z0YdbCnmZUGqgMPw95KxUw=",
+ "lastModified": 1776080969,
+ "narHash": "sha256-2uZxF6q0KOIH8tq3r65ZCz7dM+XYP3avtRP8IBq5zYY=",
"owner": "cachix",
"repo": "devenv",
- "rev": "88ac631cf8b6582ed372b8b22e3bd12240c61f64",
+ "rev": "8d558a84fa38242a7f13781670fee1a6a8902b48",
"type": "github"
},
"original": {
@@ -22,11 +22,11 @@
"nixpkgs-src": "nixpkgs-src"
},
"locked": {
- "lastModified": 1774287239,
- "narHash": "sha256-W3krsWcDwYuA3gPWsFA24YAXxOFUL6iIlT6IknAoNSE=",
+ "lastModified": 1776097194,
+ "narHash": "sha256-XD4DsgNcfXC5nlCxlAcCP5hSjTYlgLXEIoTj7fKkQg4=",
"owner": "cachix",
"repo": "devenv-nixpkgs",
- "rev": "fa7125ea7f1ae5430010a6e071f68375a39bd24c",
+ "rev": "6e8a07b02f6f8557ffab71274feac9827bcc2532",
"type": "github"
},
"original": {
@@ -39,11 +39,11 @@
"nixpkgs-src": {
"flake": false,
"locked": {
- "lastModified": 1773840656,
- "narHash": "sha256-9tpvMGFteZnd3gRQZFlRCohVpqooygFuy9yjuyRL2C0=",
+ "lastModified": 1775888245,
+ "narHash": "sha256-nwASzrRDD1JBEu/o8ekKYEXm/oJW6EMCzCRdrwcLe90=",
"owner": "NixOS",
"repo": "nixpkgs",
- "rev": "9cf7092bdd603554bd8b63c216e8943cf9b12512",
+ "rev": "13043924aaa7375ce482ebe2494338e058282925",
"type": "github"
},
"original": {
diff --git a/src/Client.purs b/src/Client.purs
@@ -52,10 +52,12 @@ type State =
, failedCovers :: Set String
, hoveredCover :: Maybe Int
, expandedSections :: Set String
+ , loadedSections :: Set String
, offset :: Int
, limit :: Int
, activeTab :: Tab
, activeFilter :: Maybe ActiveFilter
+ , statsPeriod :: Maybe Int
}
data Action
@@ -67,11 +69,15 @@ data Action
| NextPage
| PrevPage
| SwitchTab Tab
+ | SetStatsPeriod (Maybe Int)
| FilterBy String String
| ClearFilter
| HoverCover Int
| UnhoverCover
- | ToggleSection String
+ | 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 =
@@ -94,10 +100,12 @@ component =
, failedCovers: Set.empty
, hoveredCover: Nothing
, expandedSections: Set.empty
+ , loadedSections: Set.empty
, offset: 0
, limit: 25
, activeTab: ListensTab
, activeFilter: Nothing
+ , statsPeriod: Nothing
}
render state =
@@ -153,7 +161,10 @@ component =
]
]
StatsTab ->
- renderStatsView state.expandedSections state.stats
+ HH.div_
+ [ renderPeriodSelector state.statsPeriod
+ , renderStatsView state.expandedSections state.loadedSections state.stats
+ ]
, HH.div
[ HP.id "footer"
, HP.class_ (H.ClassName "small")
@@ -162,46 +173,56 @@ component =
]
]
- renderStatsView _ Nothing =
+ renderStatsView _ _ Nothing =
HH.div [ HP.class_ (H.ClassName "loading") ] [ HH.text "Loading stats..." ]
- renderStatsView expandedSections (Just (Stats { genres, labels, years })) =
+ renderStatsView expandedSections loadedSections (Just (Stats { genres, labels, years, artists, tracks })) =
HH.div_
- [ renderStatSection expandedSections "genre" "genres" genres
- , renderStatSection expandedSections "label" "labels" labels
- , renderStatSection expandedSections "year" "years" years
+ [ 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 field title entries =
+ renderStatSection expandedSections loadedSections mField title entries =
let
+ sectionKey = fromMaybe title mField
maxCount = fromMaybe 1 (maximum (map (\(StatsEntry e) -> e.count) entries))
- expanded = Set.member field expandedSections
- visible = if expanded then entries else take 10 entries
- hasMore = length entries > 10
+ 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 field) visible)
- , if hasMore then
- HH.button
- [ HP.class_ (H.ClassName "show-all-btn")
- , HE.onClick \_ -> ToggleSection field
- ]
- [ HH.text $ if expanded then "show less" else "show all (" <> show (length entries) <> ")" ]
- else
- HH.text ""
+ HH.ul_ (map (renderStatEntry maxCount mField) visible)
+ , footer
]
- renderStatEntry maxCount field (StatsEntry { name, count }) =
+ 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")
- , HE.onClick \_ -> FilterBy field name
- ]
+ ([ 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 <> "%"
@@ -211,6 +232,21 @@ component =
, HH.span [ HP.class_ (H.ClassName "stat-count") ] [ HH.text $ show count ]
]
+ renderPeriodSelector current =
+ HH.div
+ [ HP.class_ (H.ClassName "period-selector") ]
+ (map periodBtn [ Nothing, Just 7, Just 14, Just 30, Just 60, Just 90, Just 365 ])
+ where
+ periodBtn target =
+ HH.button
+ [ HP.class_ (H.ClassName $ "period-btn" <> if current == target then " active" else "")
+ , HE.onClick \_ -> SetStatsPeriod target
+ ]
+ [ HH.text $ case target of
+ Nothing -> "all time"
+ Just n -> show n
+ ]
+
renderContent state
| state.loading && state.listens == [] =
HH.ul_ [ HH.li [ HP.class_ (H.ClassName "loading") ] [ HH.text "Loading recent tracks..." ] ]
@@ -322,9 +358,13 @@ component =
StatsTab -> do
state <- H.get
when (state.stats == Nothing) do
- response <- H.liftAff fetchStats
+ 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 }
+ response <- H.liftAff $ fetchStats period
+ handleAction (ReceiveStats response)
ImageError url -> do
H.modify_ \state -> state { failedCovers = Set.insert url state.failedCovers }
NextPage -> do
@@ -339,8 +379,24 @@ component =
H.modify_ _ { hoveredCover = Just url }
UnhoverCover -> do
H.modify_ _ { hoveredCover = Nothing }
- ToggleSection field -> do
- H.modify_ \s -> s { expandedSections = if Set.member field s.expandedSections then Set.delete field s.expandedSections else Set.insert field s.expandedSections }
+ 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
@@ -365,9 +421,41 @@ component =
Left err -> pure $ Left $ "JSON decode error: " <> show err
Right (ListenBrainzResponse { payload: Payload { listens } }) -> pure $ Right listens
- fetchStats :: Aff (Either String Stats)
- fetchStats = do
- res <- AX.get ResponseFormat.json "/stats"
+ 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
+
+ fetchSectionData :: Maybe Int -> String -> Aff (Either String (Array StatsEntry))
+ fetchSectionData mDays section = do
+ let
+ periodParam = case mDays of
+ Nothing -> ""
+ Just n -> "&period=" <> show n
+ res <- AX.get ResponseFormat.json ("/stats?section=" <> section <> periodParam)
+ 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 :: Maybe Int -> Aff (Either String Stats)
+ fetchStats mDays = do
+ let
+ periodParam = case mDays of
+ Nothing -> ""
+ Just n -> "?period=" <> show n
+ res <- AX.get ResponseFormat.json ("/stats" <> periodParam)
case res of
Left err -> pure $ Left $ "Network error: " <> AX.printError err
Right response ->
diff --git a/src/Db.purs b/src/Db.purs
@@ -19,6 +19,7 @@ import Data.Traversable (traverse)
import Foreign.Object as Object
import Data.Nullable (Nullable, toMaybe, toNullable)
import Data.Array (mapMaybe, uncons, (!!))
+import Data.Int (fromString)
import Data.String (lastIndexOf, Pattern(..), take)
import Control.Monad.Rec.Class (forever)
import Node.FS.Aff as FSA
@@ -141,20 +142,26 @@ getScrobbles conn limit offset Nothing = do
[ unsafeCoerce limit, unsafeCoerce offset ]
pure $ fromMaybe [] $ traverse rowToListen rows
getScrobbles conn limit offset (Just { field, value }) = do
- let
- col = case field of
- "label" -> "rm.label"
- "year" -> "rm.release_year::VARCHAR"
- _ -> "rm.genre"
- rows <- queryAll conn
- ( "SELECT s.listened_at, s.track_name, s.artist_name, s.release_name, s.release_mbid, s.caa_release_mbid, rm.genre"
- <> " FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid"
- <> " WHERE "
- <> col
- <> " = ? ORDER BY s.listened_at DESC LIMIT ? OFFSET ?"
- )
- [ unsafeCoerce value, unsafeCoerce limit, unsafeCoerce offset ]
+ rows <- queryAll conn query [ unsafeCoerce value, unsafeCoerce limit, unsafeCoerce offset ]
pure $ fromMaybe [] $ traverse rowToListen rows
+ where
+ query = case field of
+ "artist" ->
+ "SELECT s.listened_at, s.track_name, s.artist_name, s.release_name, s.release_mbid, s.caa_release_mbid, rm.genre"
+ <> " FROM scrobbles s LEFT JOIN release_metadata rm ON s.release_mbid = rm.release_mbid"
+ <> " WHERE s.artist_name = ? ORDER BY s.listened_at DESC LIMIT ? OFFSET ?"
+ _ ->
+ let
+ col = case field of
+ "label" -> "rm.label"
+ "year" -> "rm.release_year::VARCHAR"
+ _ -> "rm.genre"
+ in
+ "SELECT s.listened_at, s.track_name, s.artist_name, s.release_name, s.release_mbid, s.caa_release_mbid, rm.genre"
+ <> " FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid"
+ <> " WHERE "
+ <> col
+ <> " = ? ORDER BY s.listened_at DESC LIMIT ? OFFSET ?"
initReleaseMetadata :: Connection -> Aff Unit
initReleaseMetadata conn = do
@@ -207,15 +214,27 @@ touchGenreCheckedAt conn mbid = do
"UPDATE release_metadata SET genre_checked_at = CAST(epoch(now()) AS INTEGER) WHERE release_mbid = ?"
[ unsafeCoerce mbid ]
-getStats :: Connection -> Aff Stats
-getStats conn = do
- genreRows <- queryAll conn "SELECT rm.genre as name, COUNT(*) as count FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid WHERE rm.genre IS NOT NULL AND rm.genre != '' GROUP BY rm.genre ORDER BY count DESC LIMIT 50" []
- labelRows <- queryAll conn "SELECT rm.label as name, COUNT(*) as count FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid WHERE rm.label IS NOT NULL AND rm.label != '' GROUP BY rm.label ORDER BY count DESC LIMIT 50" []
- yearRows <- queryAll conn "SELECT CAST(rm.release_year AS VARCHAR) as name, COUNT(*) as count FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid WHERE rm.release_year IS NOT NULL GROUP BY rm.release_year ORDER BY rm.release_year DESC" []
+getStats :: Connection -> Maybe String -> Maybe String -> Aff Stats
+getStats conn mPeriod mSection = do
+ let
+ timeFilter = case mPeriod >>= fromString of
+ Just days -> " AND s.listened_at >= CAST(epoch(now()) AS INTEGER) - " <> show (days * 86400)
+ Nothing -> ""
+ fetch name q = case mSection of
+ Nothing -> queryAll conn (q <> " LIMIT 50") []
+ Just s | s == name -> queryAll conn q []
+ Just _ -> pure []
+ genreRows <- fetch "genre" ("SELECT rm.genre as name, COUNT(*) as count FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid WHERE rm.genre IS NOT NULL AND rm.genre != ''" <> timeFilter <> " GROUP BY rm.genre ORDER BY count DESC")
+ labelRows <- fetch "label" ("SELECT rm.label as name, COUNT(*) as count FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid WHERE rm.label IS NOT NULL AND rm.label != ''" <> timeFilter <> " GROUP BY rm.label ORDER BY count DESC")
+ yearRows <- fetch "year" ("SELECT CAST(rm.release_year AS VARCHAR) as name, COUNT(*) as count FROM scrobbles s JOIN release_metadata rm ON s.release_mbid = rm.release_mbid WHERE rm.release_year IS NOT NULL" <> timeFilter <> " GROUP BY rm.release_year ORDER BY rm.release_year DESC")
+ artistRows <- fetch "artist" ("SELECT s.artist_name as name, COUNT(*) as count FROM scrobbles s WHERE s.artist_name != ''" <> timeFilter <> " GROUP BY s.artist_name ORDER BY count DESC")
+ trackRows <- fetch "track" ("SELECT s.artist_name || ' — ' || s.track_name as name, COUNT(*) as count FROM scrobbles s WHERE s.track_name != '' AND s.artist_name != ''" <> timeFilter <> " GROUP BY s.artist_name, s.track_name ORDER BY count DESC")
pure $ Stats
{ genres: mapMaybe rowToEntry genreRows
, labels: mapMaybe rowToEntry labelRows
, years: mapMaybe rowToEntry yearRows
+ , artists: mapMaybe rowToEntry artistRows
+ , tracks: mapMaybe rowToEntry trackRows
}
rowToEntry :: Json -> Maybe StatsEntry
diff --git a/src/Main.purs b/src/Main.purs
@@ -664,11 +664,11 @@ indexHtml =
opacity: 1;
}
- .stat-row {
+ .stat-row.clickable {
cursor: pointer;
}
- .stat-row:hover .stat-name {
+ .stat-row.clickable:hover .stat-name {
color: #a0c0d0;
}
@@ -723,6 +723,34 @@ indexHtml =
.show-all-btn:hover {
color: #ffffff;
}
+
+ .period-selector {
+ display: flex;
+ gap: 6px;
+ margin-bottom: 16px;
+ }
+
+ .period-btn {
+ background: none;
+ border: 1px solid #50447f;
+ color: #9fbfe7;
+ padding: 4px 12px;
+ border-radius: 3px;
+ cursor: pointer;
+ font-family: inherit;
+ font-size: 12px;
+ }
+
+ .period-btn:hover {
+ color: #ffffff;
+ border-color: #ffffff;
+ }
+
+ .period-btn.active {
+ background: #50447f;
+ color: #ffffff;
+ border-color: #50447f;
+ }
</style>
</head>
<body>
@@ -747,7 +775,7 @@ handleRequest db isSyncing coverCacheEnabled req res = do
"/healthz" -> serveHealthz db isSyncing res
"/proxy" -> serveProxy db isSyncing url res
"/cover" -> serveCover coverCacheEnabled isSyncing url res
- "/stats" -> serveStats db isSyncing res
+ "/stats" -> serveStats db isSyncing url res
"/client.js" -> serveClientJs res
"/favicon.png" -> serveAsset "image/png" "assets/favicon.png" res
_ -> do
@@ -1017,13 +1045,15 @@ serveNotFound res = do
void $ writeString w UTF8 "Not Found"
end w
-serveStats :: Connection -> Ref Boolean -> Response -> Effect Unit
-serveStats db isSyncing res = do
+serveStats :: Connection -> Ref Boolean -> URL -> Response -> Effect Unit
+serveStats db isSyncing url res = do
setHeader "Content-Type" "application/json" (toOutgoingMessage res)
setHeader "Access-Control-Allow-Origin" "*" (toOutgoingMessage res)
launchAff_ do
yieldToSync isSyncing
- stats <- getStats db
+ let period = getQueryParam "period" url
+ let section = getQueryParam "section" url
+ stats <- getStats db period section
let responseBody = stringify $ encodeJson stats
liftEffect $ do
setStatusCode 200 res
diff --git a/src/Types.purs b/src/Types.purs
@@ -153,6 +153,8 @@ newtype Stats = Stats
{ genres :: Array StatsEntry
, labels :: Array StatsEntry
, years :: Array StatsEntry
+ , artists :: Array StatsEntry
+ , tracks :: Array StatsEntry
}
derive instance eqStats :: Eq Stats
@@ -166,11 +168,15 @@ instance DecodeJson Stats where
genres <- obj .: "genres"
labels <- obj .: "labels"
years <- obj .: "years"
- pure $ Stats { genres, labels, years }
+ artists <- obj .: "artists"
+ tracks <- obj .: "tracks"
+ pure $ Stats { genres, labels, years, artists, tracks }
instance EncodeJson Stats where
- encodeJson (Stats { genres, labels, years }) =
+ encodeJson (Stats { genres, labels, years, artists, tracks }) =
"genres" := encodeJson genres
~> "labels" := encodeJson labels
~> "years" := encodeJson years
+ ~> "artists" := encodeJson artists
+ ~> "tracks" := encodeJson tracks
~> jsonEmptyObject
diff --git a/test/Main.purs b/test/Main.purs
@@ -79,6 +79,8 @@ main = do
{ genres: [StatsEntry { name: "Rock", count: 10 }]
, labels: [StatsEntry { name: "Label", count: 5 }]
, years: [StatsEntry { name: "2023", count: 15 }]
+ , artists: [StatsEntry { name: "Artist", count: 7 }]
+ , tracks: [StatsEntry { name: "Artist — Song", count: 3 }]
}
decodeJson (encodeJson stats) `shouldEqual` Right stats
@@ -145,10 +147,12 @@ main = do
[Listen { trackMetadata: TrackMetadata m }] -> m.genre `shouldEqual` Just "Rock"
_ -> fail "Expected 1 listen"
- Stats s <- getStats conn
+ Stats s <- getStats conn Nothing Nothing
length s.genres `shouldEqual` 1
length s.labels `shouldEqual` 1
length s.years `shouldEqual` 1
+ length s.artists `shouldEqual` 1
+ length s.tracks `shouldEqual` 1
-- Test Filtering (as mentioned in architecture.md)
listensFiltered <- getScrobbles conn 10 0 (Just { field: "genre", value: "Rock" })
