commit f055cbd9767fe690d2351bac8a2c794e4164aac0
parent 35059ee5306d419b0632ea23699aee9319704ac0
Author: mtmn <miro@haravara.org>
Date: Sun, 19 Apr 2026 19:41:16 +0200
feat: add about section
Diffstat:
3 files changed, 115 insertions(+), 12 deletions(-)
diff --git a/src/Client.elm b/src/Client.elm
@@ -2,7 +2,7 @@ port module Client exposing (main)
import Browser
import Dict exposing (Dict)
-import Html exposing (Html, a, button, div, h1, h2, img, input, li, span, strong, text, ul)
+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
@@ -22,6 +22,7 @@ port pushUrl : String -> Cmd msg
type alias Flags =
{ search : String
, userSlug : String
+ , allUsers : List String
}
@@ -42,6 +43,7 @@ main =
type Tab
= ListensTab
| StatsTab
+ | AboutTab
type Period
@@ -120,6 +122,7 @@ type alias Model =
, customError : Maybe String
, userSlug : String
, similarStates : Dict String SimilarState
+ , allUsers : List String
}
@@ -151,6 +154,7 @@ init flags =
, customError = Nothing
, userSlug = flags.userSlug
, similarStates = Dict.empty
+ , allUsers = flags.allUsers
}
, Cmd.batch
[ fetchListens flags.userSlug 25 offset Nothing
@@ -311,6 +315,9 @@ update msg model =
ListensTab ->
Cmd.none
+
+ AboutTab ->
+ Cmd.none
)
SetStatsPeriod period ->
@@ -712,6 +719,19 @@ view model =
, 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 ->
@@ -753,6 +773,9 @@ view model =
[ renderPeriodSelector model.statsPeriod model.showCustomInput model.customInput model.customError
, renderStatsView model.expandedSections model.loadedSections model.stats
]
+
+ AboutTab ->
+ renderAboutView model.userSlug model.allUsers
]
@@ -1242,3 +1265,42 @@ timeAgo mNow mTimestamp =
_ ->
"unknown time"
+
+
+renderAboutView : String -> List String -> Html Msg
+renderAboutView currentSlug allUsers =
+ let
+ otherUsers =
+ List.filter (\s -> s /= currentSlug) allUsers
+
+ userLink slug =
+ let
+ url =
+ if slug == "" then
+ "/"
+
+ else
+ "/u/" ++ slug
+
+ label =
+ if slug == "" then
+ "root"
+
+ else
+ slug
+ in
+ li [] [ a [ href url ] [ text label ] ]
+ in
+ div []
+ [ p [ class "about-description" ]
+ [ text "corpus is a self-hosted music scrobble viewer. it aggregates listening history from ListenBrainz and Last.fm, enriches tracks with metadata from MusicBrainz, and provides browsable listen history and statistics." ]
+ , if List.isEmpty otherUsers then
+ text ""
+
+ else
+ div [ class "stats-section" ]
+ [ h2 [] [ text "users" ]
+ , ul [ class "about-users" ]
+ (List.map userLink otherUsers)
+ ]
+ ]
diff --git a/src/Main.purs b/src/Main.purs
@@ -332,6 +332,7 @@ handleRequest :: Boolean -> Array UserContext -> Request -> Response -> Effect U
handleRequest metricsEnabled contexts req res = do
let method = IM.method req
let rawUrl = IM.url req
+ let allSlugs = map _.slug contexts
case URL.fromRelative rawUrl "http://localhost" of
Nothing ->
serveNotFound res
@@ -344,7 +345,7 @@ handleRequest metricsEnabled contexts req res = do
"/favicon.png" ->
serveAsset "image/png" "assets/favicon.png" res
"/" ->
- serveIndex "" res
+ serveIndex allSlugs "" res
"/metrics" ->
if metricsEnabled then serveMetrics res
else do
@@ -363,7 +364,7 @@ handleRequest metricsEnabled contexts req res = do
_ ->
case stripPrefix (Pattern "/u/") path of
Just slug ->
- serveIndex slug res
+ serveIndex allSlugs slug res
Nothing -> do
Log.warn $ "Path not found: " <> path
serveNotFound res
@@ -379,12 +380,12 @@ handleRequest metricsEnabled contexts req res = do
Just ctx ->
f ctx
-serveIndex :: String -> Response -> Effect Unit
-serveIndex slug res = do
+serveIndex :: Array String -> String -> Response -> Effect Unit
+serveIndex allSlugs slug res = do
setHeader "Content-Type" "text/html" (toOutgoingMessage res)
setStatusCode 200 res
let w = toWriteable (toOutgoingMessage res)
- void $ writeString w UTF8 (indexHtml slug)
+ void $ writeString w UTF8 (indexHtml slug allSlugs)
end w
serveMetrics :: Response -> Effect Unit
diff --git a/src/Templates.purs b/src/Templates.purs
@@ -1,9 +1,13 @@
module Templates where
import Prelude
+import Data.String.Common (joinWith)
-indexHtml :: String -> String
-indexHtml userSlug =
+indexHtml :: String -> Array String -> String
+indexHtml userSlug allUsers =
+ let
+ usersJson = "[" <> joinWith "," (map (\s -> "\"" <> s <> "\"") allUsers) <> "]"
+ in
"""<!DOCTYPE html>
<html lang="en">
<head>
@@ -31,15 +35,15 @@ indexHtml userSlug =
.container {
max-width: 800px;
margin: 0 auto;
+ padding: 24px 20px;
}
h1 {
color: #ffffff;
- margin-bottom: 20px;
+ margin: 0 0 20px 0;
font-size: 24px;
border-bottom: 2px solid #50447f;
- display: inline-block;
- padding-bottom: 5px;
+ padding-bottom: 8px;
}
ul {
@@ -563,6 +567,40 @@ indexHtml userSlug =
.track-item li {
margin: 0;
}
+
+ .about-description {
+ color: #a0c0d0;
+ font-size: 13px;
+ line-height: 1.8;
+ margin: 0 0 24px 0;
+ }
+
+ .about-users {
+ list-style: none;
+ padding: 0;
+ margin: 0;
+ }
+
+ .about-users li {
+ background: none;
+ border: none;
+ border-radius: 0;
+ padding: 4px 0;
+ margin-bottom: 0;
+ display: block;
+ box-shadow: none;
+ }
+
+ .about-users a {
+ color: #9fbfe7;
+ text-decoration: none;
+ font-size: 13px;
+ }
+
+ .about-users a:hover {
+ color: #ffffff;
+ text-decoration: underline;
+ }
</style>
</head>
<body>
@@ -571,9 +609,11 @@ indexHtml userSlug =
<script>
var userSlug = '""" <> userSlug <>
"""';
+ var allUsers = """ <> usersJson <>
+ """;
var app = Elm.Client.init({
node: document.getElementById('app'),
- flags: { search: window.location.search, userSlug: userSlug }
+ flags: { search: window.location.search, userSlug: userSlug, allUsers: allUsers }
});
app.ports.pushUrl.subscribe(function(url) {
var prefix = userSlug ? '/u/' + userSlug : '';