commit 0f9a2ee5ea52ea2feb0b197ea1db5da5679cb4b1
parent 029bb36472c6548b13ab3917224bd336f554d7fa
Author: mtmn <miro@haravara.org>
Date: Sun, 19 Apr 2026 03:25:40 +0200
Merge branch 'feat/add-cosine-club-recs'
Diffstat:
6 files changed, 414 insertions(+), 10 deletions(-)
diff --git a/src/Client.elm b/src/Client.elm
@@ -1,6 +1,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.Attributes as Attr exposing (class, disabled, href, placeholder, src, style, target, type_, value)
import Html.Events exposing (on, onClick, onInput)
@@ -81,6 +82,20 @@ type alias Stats =
}
+type alias SimilarTrack =
+ { artist : String
+ , track : String
+ , score : Maybe Float
+ , videoUri : Maybe String
+ }
+
+
+type SimilarState
+ = SimilarLoading
+ | SimilarLoaded (List SimilarTrack)
+ | SimilarError String
+
+
-- MODEL
@@ -88,7 +103,6 @@ type alias Stats =
type alias Model =
{ listens : List Listen
, stats : Maybe Stats
- , lastCheck : Maybe Time.Posix
, error : Maybe String
, loading : Bool
, currentTime : Maybe Time.Posix
@@ -105,6 +119,7 @@ type alias Model =
, showCustomInput : Bool
, customError : Maybe String
, userSlug : String
+ , similarStates : Dict String SimilarState
}
@@ -119,7 +134,6 @@ init flags =
in
( { listens = []
, stats = Nothing
- , lastCheck = Nothing
, error = Nothing
, loading = True
, currentTime = Nothing
@@ -136,6 +150,7 @@ init flags =
, showCustomInput = False
, customError = Nothing
, userSlug = flags.userSlug
+ , similarStates = Dict.empty
}
, Cmd.batch
[ fetchListens flags.userSlug 25 offset Nothing
@@ -194,6 +209,8 @@ type Msg
| ExpandSection String
| ShowAllSection String
| CollapseSection String
+ | FetchSimilar String String
+ | FetchSimilarTracks String String (Result Http.Error (List SimilarTrack))
@@ -213,7 +230,7 @@ update msg model =
( { model | currentTime = Just time }, Cmd.none )
GotTime time ->
- ( { model | lastCheck = Just time, currentTime = Just time }, Cmd.none )
+ ( { model | currentTime = Just time }, Cmd.none )
GotListens result ->
let
@@ -398,6 +415,34 @@ update msg model =
, 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 =
@@ -495,6 +540,14 @@ statsUrl userSlug period mSection =
"/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
@@ -604,6 +657,20 @@ sectionEntriesDecoder section =
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
@@ -700,24 +767,44 @@ renderContent model =
ul [] [ li [ class "error" ] [ text err ] ]
Nothing ->
- ul [ Attr.id "tracks-container" ]
+ div [ class "tracks-with-similar" ]
(List.indexedMap
(\idx listen ->
- renderListen model.userSlug model.currentTime model.failedCovers model.hoveredCover 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 -> Int -> Listen -> Html Msg
-renderListen userSlug currentTime failedCovers hoveredCover idx listen =
+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 ->
@@ -743,6 +830,9 @@ renderListen userSlug currentTime failedCovers hoveredCover idx listen =
isZoomed =
hoveredCover == Just idx
+
+ isActive =
+ Dict.member key similarStates
in
li [ class "success" ]
[ div [ class "track-info" ]
@@ -794,10 +884,75 @@ renderListen userSlug currentTime failedCovers hoveredCover idx listen =
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
diff --git a/src/Config.purs b/src/Config.purs
@@ -21,6 +21,7 @@ type UserConfig =
, lastfmUser :: Maybe String
, lastfmApiKey :: Maybe String
, discogsToken :: Maybe String
+ , cosineApiKey :: Maybe String
, databaseFile :: String
, s3Bucket :: Maybe String
, s3Region :: String
@@ -83,6 +84,7 @@ loadConfig path = do
portStr <- liftEffect $ lookupEnv "PORT"
lastfmApiKey <- liftEffect $ lookupEnv "LASTFM_API_KEY"
discogsToken <- liftEffect $ lookupEnv "DISCOGS_TOKEN"
+ cosineApiKey <- liftEffect $ lookupEnv "COSINE_API_KEY"
s3Bucket <- liftEffect $ lookupEnv "S3_BUCKET"
s3Region <- liftEffect $ map (fromMaybe "us-east-1") $ lookupEnv "S3_REGION"
awsAccessKeyId <- liftEffect $ lookupEnv "AWS_ACCESS_KEY_ID"
@@ -99,6 +101,7 @@ loadConfig path = do
fillCreds cfg = cfg
{ lastfmApiKey = lastfmApiKey
, discogsToken = discogsToken
+ , cosineApiKey = cosineApiKey
, s3Bucket = s3Bucket
, s3Region = s3Region
, awsAccessKeyId = awsAccessKeyId
@@ -175,6 +178,7 @@ decodeUserConfig json = do
, lastfmUser
, lastfmApiKey: Nothing
, discogsToken: Nothing
+ , cosineApiKey: Nothing
, databaseFile
, s3Bucket: Nothing
, s3Region: "us-east-1"
diff --git a/src/Main.purs b/src/Main.purs
@@ -22,7 +22,8 @@ import Node.Stream.Aff (readableToStringUtf8)
import Node.Encoding (Encoding(UTF8))
import Node.Net.Server (listenTcp, listeningH)
import Node.Buffer (fromArrayBuffer)
-import Data.Either (Either(..))
+import Data.Either (Either(..), hush)
+import Control.Monad.Error.Class (throwError)
import Effect.Exception as Exception
import Effect.Aff (Aff, launchAff_, makeAff, nonCanceler, try, delay, forkAff, joinFiber)
import Effect.Aff.AVar (AVar)
@@ -355,6 +356,8 @@ handleRequest metricsEnabled contexts req res = do
withUser url \ctx -> serveStats ctx.conn url res
"/cover" ->
withUser url \ctx -> serveCover ctx.config ctx.slug url res
+ "/similar" ->
+ withUser url \ctx -> serveSimilar ctx.config url res
"/healthz" ->
withUser url \ctx -> serveHealthz ctx.conn res
_ ->
@@ -641,6 +644,74 @@ serveNotFound res = do
void $ writeString w UTF8 "Not Found"
end w
+serveBadRequest :: Response -> String -> Effect Unit
+serveBadRequest res message = do
+ setHeader "Content-Type" "text/plain" (toOutgoingMessage res)
+ setStatusCode 400 res
+ let w = toWriteable (toOutgoingMessage res)
+ void $ writeString w UTF8 message
+ end w
+
+serveError :: Response -> Int -> String -> String -> Effect Unit
+serveError res statusCode statusName message = do
+ setHeader "Content-Type" "text/plain" (toOutgoingMessage res)
+ setStatusCode statusCode res
+ let w = toWriteable (toOutgoingMessage res)
+ void $ writeString w UTF8 (statusName <> ": " <> message)
+ end w
+
+fetchCosineSimilar :: UserConfig -> String -> Aff String
+fetchCosineSimilar cfg query = do
+ let apiKey = fromMaybe "" cfg.cosineApiKey
+ if apiKey == "" then do
+ Log.warn "cosineApiKey not configured for similar tracks"
+ pure "{\"data\":{\"similar_tracks\":[]},\"success\":true}"
+ else do
+ let headers = { "User-Agent": "corpus/1.0 +https://codeberg.org/mtmn/corpus", "Authorization": "Bearer " <> apiKey }
+ let searchUrl = "https://cosine.club/api/v1/search?q=" <> (fromMaybe "" $ encodeURIComponent query) <> "&limit=1"
+ Log.info $ "Cosine Club: searching for: " <> query
+ searchResult <- try $ fetch searchUrl { method: GET, headers: headers }
+ case searchResult of
+ Left err ->
+ throwError err
+ Right searchRes ->
+ if searchRes.status == 429 then do
+ Log.warn "Cosine Club: rate limited on search"
+ throwError (Exception.error "Rate limit exceeded")
+ else if searchRes.status /= 200 then do
+ Log.warn $ "Cosine Club: search returned " <> show searchRes.status
+ throwError (Exception.error "Search API error")
+ else do
+ searchBody <- searchRes.text
+ let
+ mTrackId = do
+ json <- hush $ parseJson searchBody
+ obj <- toObject json
+ arr <- Object.lookup "data" obj >>= toArray
+ first <- arr !! 0
+ firstObj <- toObject first
+ Object.lookup "id" firstObj >>= toString
+ case mTrackId of
+ Nothing -> do
+ Log.info $ "Cosine Club: track not indexed: " <> query
+ pure "{\"data\":{\"similar_tracks\":[]},\"success\":true}"
+ Just trackId -> do
+ let similarUrl = "https://cosine.club/api/v1/tracks/" <> trackId <> "/similar?limit=10"
+ Log.info $ "Cosine Club: fetching similar for ID " <> trackId
+ similarResult <- try $ fetch similarUrl { method: GET, headers: headers }
+ case similarResult of
+ Left err ->
+ throwError err
+ Right similarRes ->
+ if similarRes.status == 429 then do
+ Log.warn "Cosine Club: rate limited on similar"
+ throwError (Exception.error "Rate limit exceeded")
+ else if similarRes.status /= 200 then do
+ Log.warn $ "Cosine Club: similar API returned " <> show similarRes.status
+ throwError (Exception.error "Similar API error")
+ else
+ similarRes.text
+
serveStats :: Connection -> URL -> Response -> Effect Unit
serveStats db url res = do
setHeader "Content-Type" "application/json" (toOutgoingMessage res)
@@ -658,6 +729,29 @@ serveStats db url res = do
void $ writeString w UTF8 responseBody
end w
+serveSimilar :: UserConfig -> URL -> Response -> Effect Unit
+serveSimilar cfg url res = do
+ setHeader "Content-Type" "application/json" (toOutgoingMessage res)
+ launchAff_ do
+ let artist = fromMaybe "" (getQueryParam "artist" url)
+ let track = fromMaybe "" (getQueryParam "track" url)
+ if artist == "" || track == "" then
+ liftEffect $ serveBadRequest res "Artist and track parameters are required"
+ else do
+ let query = artist <> " - " <> track
+ result <- try $ fetchCosineSimilar cfg query
+
+ case result of
+ Left err -> do
+ Log.error $ "Cosine Club API error: " <> Exception.message err
+ liftEffect $ serveError res 502 "Bad Gateway" "Failed to fetch similar tracks"
+ Right responseBody -> do
+ liftEffect $ do
+ setStatusCode 200 res
+ let w = toWriteable (toOutgoingMessage res)
+ void $ writeString w UTF8 responseBody
+ end w
+
type MbData = { genre :: Maybe String, label :: Maybe String, year :: Maybe Int }
fetchMusicBrainzRelease :: String -> Aff (Maybe MbData)
diff --git a/src/Templates.purs b/src/Templates.purs
@@ -428,6 +428,158 @@ indexHtml userSlug =
font-size: 12px;
margin-top: 4px;
}
+
+ .similar-btn {
+ background: none;
+ border: 1px solid #50447f;
+ color: #9fbfe7;
+ padding: 2px 8px;
+ border-radius: 3px;
+ cursor: pointer;
+ font-family: inherit;
+ font-size: 10px;
+ margin-top: 4px;
+ transition: all 0.2s ease;
+ }
+
+ .similar-btn:hover {
+ background: #50447f;
+ color: #ffffff;
+ border-color: #ffffff;
+ }
+
+ .similar-btn.active {
+ background: #521e40;
+ color: #ffffff;
+ border-color: #50447f;
+ box-shadow: 2px 2px 0px #50447f;
+ }
+
+ .similar-panel {
+ margin-top: 10px;
+ background: #521e40;
+ border: 1px solid #50447f;
+ border-radius: 4px;
+ padding: 10px;
+ box-shadow: 2px 2px 0px #50447f;
+ }
+
+ .similar-panel-header {
+ font-size: 11px;
+ color: #9fbfe7;
+ text-transform: uppercase;
+ letter-spacing: 1px;
+ margin-bottom: 8px;
+ font-weight: bold;
+ }
+
+ .similar-loading {
+ color: #9fbfe7;
+ font-size: 12px;
+ text-align: center;
+ padding: 8px;
+ }
+
+ .similar-error {
+ color: #eca28f;
+ font-size: 12px;
+ text-align: center;
+ padding: 8px;
+ }
+
+ .similar-empty {
+ color: #9fbfe7;
+ font-size: 12px;
+ text-align: center;
+ padding: 8px;
+ }
+
+ .similar-track {
+ display: flex;
+ justify-content: space-between;
+ align-items: center;
+ padding: 6px 8px;
+ margin-bottom: 4px;
+ background: rgba(82, 30, 64, 0.5);
+ border-radius: 3px;
+ border-left: 2px solid #50447f;
+ }
+
+ .similar-track:last-child {
+ margin-bottom: 0;
+ }
+
+ .similar-track-info {
+ flex: 1;
+ min-width: 0;
+ }
+
+ .similar-track-name {
+ font-size: 12px;
+ color: #ffffff;
+ font-weight: 500;
+ white-space: nowrap;
+ overflow: hidden;
+ text-overflow: ellipsis;
+ }
+
+ .similar-track-artist {
+ font-size: 11px;
+ color: #a0c0d0;
+ margin-top: 1px;
+ white-space: nowrap;
+ overflow: hidden;
+ text-overflow: ellipsis;
+ }
+
+ .similar-score {
+ font-size: 10px;
+ color: #9fbfe7;
+ background: #521e40;
+ border: 1px solid #50447f;
+ padding: 2px 6px;
+ border-radius: 2px;
+ margin-right: 8px;
+ font-weight: 500;
+ }
+
+ .similar-link {
+ color: #9fbfe7;
+ text-decoration: none;
+ font-size: 12px;
+ background: #521e40;
+ border: 1px solid #50447f;
+ padding: 2px 6px;
+ border-radius: 2px;
+ transition: all 0.2s ease;
+ }
+
+ .similar-link:hover {
+ color: #ffffff;
+ background: #50447f;
+ }
+
+ .tracks-with-similar {
+ display: flex;
+ flex-direction: column;
+ gap: 10px;
+ }
+
+ .track-with-similar-container {
+ display: flex;
+ flex-direction: column;
+ gap: 10px;
+ }
+
+ .track-item {
+ list-style: none;
+ padding: 0;
+ margin: 0;
+ }
+
+ .track-item li {
+ margin: 0;
+ }
</style>
</head>
<body>
diff --git a/users.dhall b/users.dhall
@@ -26,7 +26,6 @@ in { users =
with listenbrainzUser = Some "mtmn"
with databaseFile = "corpus-mtmn.db"
with backupEnabled = True
- with initialSync = True
}
]
}
diff --git a/users.json b/users.json
@@ -6,7 +6,7 @@
"backupIntervalHours": 1,
"coverCacheEnabled": true,
"databaseFile": "corpus-mtmn.db",
- "initialSync": true,
+ "initialSync": false,
"listenbrainzUser": "mtmn"
},
"slug": ""
