commit 96b22d1c3a5e8459c4807eb86d06533a48233cfb
parent 12fde33d119bb89bc332c4e17551d03feeadb328
Author: mtmn <miro@haravara.org>
Date: Mon, 1 Jun 2026 21:26:25 +0200
fix: better type safety
Diffstat:
| M | src/Db.purs | | | 34 | ++++++++++++++++++++-------------- |
| M | src/Main.purs | | | 21 | ++++++--------------- |
| M | src/Sync.purs | | | 79 | ++++++++++++++++++++++++++++++++----------------------------------------------- |
| M | src/Types.purs | | | 137 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- |
| M | test/Main.purs | | | 20 | ++++++++++---------- |
5 files changed, 203 insertions(+), 88 deletions(-)
diff --git a/src/Db.purs b/src/Db.purs
@@ -11,8 +11,10 @@ import Data.Either (Either(..))
import Data.Foldable (for_)
import Data.Formatter.DateTime (formatDateTime)
import Data.Function.Uncurried (Fn2, Fn4, runFn2, runFn4)
-import Data.Int (fromString, round)
+import Data.Int as Int
import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
import Data.Nullable (Nullable, toMaybe, toNullable)
import Data.String (Pattern(..), split, stripSuffix)
import Data.String.Common (joinWith)
@@ -40,14 +42,18 @@ foreign import data Connection :: Type
data FilterField = FilterArtist | FilterAlbum | FilterLabel | FilterYear | FilterGenre | FilterTrack
derive instance Eq FilterField
-
+derive instance Generic FilterField _
instance Show FilterField where
- show FilterArtist = "FilterArtist"
- show FilterAlbum = "FilterAlbum"
- show FilterLabel = "FilterLabel"
- show FilterYear = "FilterYear"
- show FilterGenre = "FilterGenre"
- show FilterTrack = "FilterTrack"
+ show = genericShow
+
+fromString :: String -> Maybe FilterField
+fromString "artist" = Just FilterArtist
+fromString "album" = Just FilterAlbum
+fromString "label" = Just FilterLabel
+fromString "year" = Just FilterYear
+fromString "genre" = Just FilterGenre
+fromString "track" = Just FilterTrack
+fromString _ = Nothing
foreign import connectImpl :: Fn2 String (Nullable Error -> Nullable Connection -> Effect Unit) (Effect Unit)
foreign import runImpl :: Fn4 Connection String (Array Foreign) (Nullable Error -> Effect Unit) (Effect Unit)
@@ -170,7 +176,7 @@ getOldestTs conn = do
row <- rows !! 0
obj <- toObject row
n <- Object.lookup "min_ts" obj >>= toNumber
- let ts = round n
+ let ts = Int.round n
if ts == 0 then Nothing else Just ts
upsertScrobble :: Connection -> Listen -> Aff Unit
@@ -299,10 +305,10 @@ getStats conn mPeriod mFrom mTo mSection = do
buildTimeFilterAndParams :: { timeFilter :: String, params :: Array Foreign }
buildTimeFilterAndParams = case mFrom, mTo of
Just from, Just to ->
- { timeFilter: " AND s.listened_at >= CAST(epoch(TIMESTAMP '" <> from <> " 00:00:00') AS INTEGER) AND s.listened_at < CAST(epoch(TIMESTAMP '" <> to <> " 00:00:00') AS INTEGER) + 86400"
- , params: []
+ { timeFilter: " AND s.listened_at >= CAST(epoch(TIMESTAMP ? || ' 00:00:00') AS INTEGER) AND s.listened_at < CAST(epoch(TIMESTAMP ? || ' 00:00:00') AS INTEGER) + 86400"
+ , params: [ unsafeCoerce from, unsafeCoerce to ]
}
- _, _ -> case mPeriod >>= fromString of
+ _, _ -> case mPeriod >>= Int.fromString of
Just days ->
{ timeFilter: " AND s.listened_at >= CAST(epoch(now()) AS INTEGER) - ?"
, params: [ unsafeCoerce (days * 86400) ]
@@ -331,7 +337,7 @@ rowToEntry :: Json -> Maybe StatsEntry
rowToEntry json = do
obj <- toObject json
name <- Object.lookup "name" obj >>= toString
- count <- map round $ Object.lookup "count" obj >>= toNumber
+ count <- map Int.round $ Object.lookup "count" obj >>= toNumber
pure $ StatsEntry { name, count }
getArtistReleasesByMbids :: Connection -> Array String -> Aff (Object.Object { artist :: String, release :: String })
@@ -357,7 +363,7 @@ getArtistReleasesByMbids conn mbids = do
rowToListen :: Json -> Maybe Listen
rowToListen json = do
obj <- toObject json
- listenedAt <- map round $ Object.lookup "listened_at" obj >>= toNumber
+ listenedAt <- map Int.round $ Object.lookup "listened_at" obj >>= toNumber
trackName <- Object.lookup "track_name" obj >>= toString
artistName <- Object.lookup "artist_name" obj >>= toString
releaseName <- Object.lookup "release_name" obj >>= toString
diff --git a/src/Main.purs b/src/Main.purs
@@ -10,13 +10,13 @@ import Data.Array (find, length)
import Data.Array as Data.Array
import Data.Either (Either(..), fromRight')
import Data.Foldable (for_, traverse_)
-import Data.Int (fromString, toNumber)
+import Data.Int as Int
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String (Pattern(..), stripPrefix)
import Data.String.Regex (regex, replace, parseFlags)
import Partial.Unsafe (unsafeCrashWith)
import Data.Traversable (traverse)
-import Db (Connection, FilterField(..), backupDb, connect, getOrCreateToken, getTokenUser, getScrobbles, getStats, initDb, initReleaseMetadata, ping, upsertScrobble, withTransaction)
+import Db (Connection, backupDb, connect, fromString, getOrCreateToken, getScrobbles, getStats, getTokenUser, initDb, initReleaseMetadata, ping, upsertScrobble, withTransaction)
import Effect (Effect)
import Effect.Aff (Aff, Fiber, forkAff, joinFiber, killFiber, launchAff_, try)
import Effect.Aff.AVar (AVar)
@@ -212,26 +212,17 @@ serveClientJs res = do
getQueryParam :: String -> URL -> Maybe String
getQueryParam name url = URLSearchParams.get name (URL.searchParams url)
-parseFilterField :: String -> Maybe FilterField
-parseFilterField "artist" = Just FilterArtist
-parseFilterField "album" = Just FilterAlbum
-parseFilterField "label" = Just FilterLabel
-parseFilterField "year" = Just FilterYear
-parseFilterField "genre" = Just FilterGenre
-parseFilterField "track" = Just FilterTrack
-parseFilterField _ = Nothing
-
serveProxy :: String -> Connection -> URL -> Response -> Effect Unit
serveProxy corsOrigin db url res = do
setHeader "Content-Type" "application/json" (toOutgoingMessage res)
setHeader "Access-Control-Allow-Origin" corsOrigin (toOutgoingMessage res)
launchAff_ do
- let limit = fromMaybe 25 (getQueryParam "limit" url >>= fromString)
- let offset = fromMaybe 0 (getQueryParam "offset" url >>= fromString)
+ let limit = fromMaybe 25 (getQueryParam "limit" url >>= Int.fromString)
+ let offset = fromMaybe 0 (getQueryParam "offset" url >>= Int.fromString)
let
mFilter = do
- field <- getQueryParam "filterField" url >>= parseFilterField
+ field <- getQueryParam "filterField" url >>= fromString
value <- getQueryParam "filterValue" url
pure { field, value }
@@ -418,7 +409,7 @@ startUser { slug, name, config } = do
enrichMetadataFiber <- forkAff $ enrichMetadata conn config slug
backupFiber <-
- if config.backupEnabled then Just <$> forkAff (backupDb conn config.databaseFile (s3ConfigFromUser config) (toNumber config.backupIntervalHours * 3600000.0) slug)
+ if config.backupEnabled then Just <$> forkAff (backupDb conn config.databaseFile (s3ConfigFromUser config) (Int.toNumber config.backupIntervalHours * 3600000.0) slug)
else pure Nothing
let displayName = fromMaybe (if slug == "" then "root" else slug) name
diff --git a/src/Sync.purs b/src/Sync.purs
@@ -13,15 +13,13 @@ import Prelude
import Control.Monad.Rec.Class (forever)
import Data.Argonaut (decodeJson, parseJson)
-import Data.Argonaut.Core (Json, toArray, toObject, toString, toNumber, stringify)
+import Data.Argonaut.Core (Json, stringify)
import Data.Array (length, mapMaybe, null)
import Data.Either (Either(..))
import Data.Foldable (foldM, for_)
-import Data.Int (fromNumber, fromString)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Time.Duration (Milliseconds(..))
import Data.Tuple (Tuple(..))
-import Control.Alt ((<|>))
import Db (Connection, checkExists, getOldestTs, upsertScrobble, withTransaction)
import Effect.Aff (Aff, delay, launchAff_, makeAff, nonCanceler, try)
import Effect.Aff.AVar (AVar)
@@ -31,7 +29,6 @@ import Effect.Exception as Exception
import Effect.Uncurried (mkEffectFn1)
import Fetch (fetch, Method(GET))
import Fetch.Argonaut.Json (fromJson)
-import Foreign.Object as Object
import JSURI (encodeURIComponent)
import Log as Log
import Metrics as Metrics
@@ -40,7 +37,7 @@ import Node.HTTP.ClientRequest as Client
import Node.HTTP.IncomingMessage as IM
import Node.HTTPS as HTTPS
import Node.Stream.Aff (readableToStringUtf8)
-import Types (Listen(..), ListenBrainzResponse(..), MbidMapping(..), Payload(..), TrackMetadata(..))
+import Types (Listen(..), ListenBrainzResponse(..), MbidMapping(..), Payload(..), TrackMetadata(..), LastfmResponse(..), LastfmRecentTracks(..), LastfmAttr(..), LastfmTracks(..), LastfmArtist(..), LastfmAlbum(..), LastfmDate(..), LastfmTrack(..))
import Unsafe.Coerce (unsafeCoerce)
listenBrainzUrl :: String -> String
@@ -102,50 +99,38 @@ fetchLastfmPage apiKey lfmUser page mTo = withRetry "Last.fm fetch" do
liftEffect $ Exception.error ("Last.fm API returned status " <> show fr.status) # Exception.throwException
parseLastfmResponse :: Json -> Maybe { tracks :: Array Json, totalPages :: Int }
-parseLastfmResponse json = do
- let
- obj = toObject json
- rt = obj >>= Object.lookup "recenttracks" >>= toObject
- mTracks = rt >>= Object.lookup "track"
- tracks = case mTracks of
- Just t -> fromMaybe [ t ] (toArray t)
- Nothing -> []
- attr = rt >>= Object.lookup "@attr" >>= toObject
- totalPages = fromMaybe 0 $ attr >>= Object.lookup "totalPages" >>= \tp ->
- (toString tp >>= fromString) <|> (toNumber tp >>= fromNumber)
- case rt, attr of
- Just _, Just _ -> Just { tracks, totalPages }
- _, _ -> Nothing
+parseLastfmResponse json = case decodeJson json of
+ Right (LastfmResponse { recenttracks: LastfmRecentTracks { track, attr: LastfmAttr { totalPages } } }) ->
+ let
+ tracks = case track of
+ LastfmTrackArray' ts -> ts
+ LastfmTrackSingle' t -> [ t ]
+ in
+ Just { tracks, totalPages: totalPages }
+ Left _ -> Nothing
lastfmTrackToListen :: Json -> Maybe Listen
-lastfmTrackToListen json = do
- obj <- toObject json
- trackName <- Object.lookup "name" obj >>= toString
- artistObj <- Object.lookup "artist" obj >>= toObject
- artistName <- Object.lookup "#text" artistObj >>= toString
- albumObj <- Object.lookup "album" obj >>= toObject
- let releaseName = Object.lookup "#text" albumObj >>= toString
- let
- releaseMbid = do
- s <- Object.lookup "mbid" albumObj >>= toString
- if s == "" then Nothing else Just s
- dateObj <- Object.lookup "date" obj >>= toObject
- utsStr <- Object.lookup "uts" dateObj >>= toString
- ts <- fromString utsStr
- pure $ Listen
- { listenedAt: Just ts
- , trackMetadata: TrackMetadata
- { trackName: Just trackName
- , artistName: Just artistName
- , releaseName: releaseName
- , genre: Nothing
- , label: Nothing
- , mbidMapping: Just $ MbidMapping
- { releaseMbid: releaseMbid
- , caaReleaseMbid: releaseMbid
- }
- }
- }
+lastfmTrackToListen json = case decodeJson json of
+ Right (LastfmTrack { name, artist: LastfmArtist { text: artistName }, album, date }) -> do
+ ts <- date >>= \(LastfmDate { uts }) -> Just uts
+ let
+ releaseName = album >>= \(LastfmAlbum { text }) -> text
+ releaseMbid = album >>= \(LastfmAlbum { mbid }) -> if mbid == "" then Nothing else Just mbid
+ pure $ Listen
+ { listenedAt: Just ts
+ , trackMetadata: TrackMetadata
+ { trackName: Just name
+ , artistName: Just artistName
+ , releaseName: releaseName
+ , genre: Nothing
+ , label: Nothing
+ , mbidMapping: Just $ MbidMapping
+ { releaseMbid: releaseMbid
+ , caaReleaseMbid: releaseMbid
+ }
+ }
+ }
+ Left _ -> Nothing
recordSyncSuccess :: String -> String -> Int -> Aff Unit
recordSyncSuccess slug source n = do
diff --git a/src/Types.purs b/src/Types.purs
@@ -3,8 +3,11 @@ module Types where
import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (.:?), (:=), (~>))
-import Data.Argonaut.Core (jsonEmptyObject)
-import Data.Maybe (Maybe)
+import Data.Argonaut.Decode.Error (JsonDecodeError(..))
+import Data.Either (Either(..))
+import Data.Argonaut.Core (Json, toArray, jsonEmptyObject, toNumber, toString)
+import Data.Int (fromString, fromNumber)
+import Data.Maybe (Maybe(..), fromMaybe)
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
@@ -203,6 +206,136 @@ instance EncodeJson MbidMapping where
~> "caa_release_mbid" := encodeJson caaReleaseMbid
~> jsonEmptyObject
+-- Last.fm API types
+
+newtype LastfmAttr = LastfmAttr
+ { totalPages :: Int
+ }
+
+derive instance genericLastfmAttr :: Generic LastfmAttr _
+instance showLastfmAttr :: Show LastfmAttr where
+ show = genericShow
+
+instance decodeJsonLastfmAttr :: DecodeJson LastfmAttr where
+ decodeJson json = do
+ obj <- decodeJson json
+ tpJson <- obj .: "totalPages"
+ let
+ tpStr = toString tpJson
+ tpNum = toNumber tpJson
+ parsed = case tpStr >>= fromString of
+ Just n -> Just n
+ Nothing -> tpNum >>= fromNumber
+ case parsed of
+ Just n -> pure $ LastfmAttr { totalPages: n }
+ Nothing -> Left $ TypeMismatch "Invalid totalPages"
+
+newtype LastfmTrackArray = LastfmTrackArray (Array Json)
+newtype LastfmTrackSingle = LastfmTrackSingle Json
+
+data LastfmTracks = LastfmTrackArray' (Array Json) | LastfmTrackSingle' Json
+
+instance showLastfmTracks :: Show LastfmTracks where
+ show (LastfmTrackArray' _) = "LastfmTrackArray' _"
+ show (LastfmTrackSingle' _) = "LastfmTrackSingle' _"
+
+newtype LastfmRecentTracks = LastfmRecentTracks
+ { track :: LastfmTracks
+ , attr :: LastfmAttr
+ }
+
+derive instance genericLastfmRecentTracks :: Generic LastfmRecentTracks _
+instance showLastfmRecentTracks :: Show LastfmRecentTracks where
+ show = genericShow
+
+instance decodeJsonLastfmRecentTracks :: DecodeJson LastfmRecentTracks where
+ decodeJson json = do
+ obj <- decodeJson json
+ attr <- obj .: "@attr"
+ trackResult <- obj .:? "track"
+ tracks <- case trackResult of
+ Nothing -> pure $ LastfmTrackArray' []
+ Just trackJson -> case toArray trackJson of
+ Just arr -> pure $ LastfmTrackArray' arr
+ Nothing -> pure $ LastfmTrackSingle' trackJson
+ pure $ LastfmRecentTracks { track: tracks, attr }
+
+newtype LastfmResponse = LastfmResponse
+ { recenttracks :: LastfmRecentTracks
+ }
+
+derive instance genericLastfmResponse :: Generic LastfmResponse _
+instance showLastfmResponse :: Show LastfmResponse where
+ show = genericShow
+
+instance decodeJsonLastfmResponse :: DecodeJson LastfmResponse where
+ decodeJson json = do
+ obj <- decodeJson json
+ recenttracks <- obj .: "recenttracks"
+ pure $ LastfmResponse { recenttracks }
+
+newtype LastfmArtist = LastfmArtist { text :: String }
+
+derive instance genericLastfmArtist :: Generic LastfmArtist _
+instance showLastfmArtist :: Show LastfmArtist where
+ show = genericShow
+
+instance decodeJsonLastfmArtist :: DecodeJson LastfmArtist where
+ decodeJson json = do
+ obj <- decodeJson json
+ text <- obj .: "#text"
+ pure $ LastfmArtist { text }
+
+newtype LastfmAlbum = LastfmAlbum
+ { text :: Maybe String
+ , mbid :: String
+ }
+
+derive instance genericLastfmAlbum :: Generic LastfmAlbum _
+instance showLastfmAlbum :: Show LastfmAlbum where
+ show = genericShow
+
+instance decodeJsonLastfmAlbum :: DecodeJson LastfmAlbum where
+ decodeJson json = do
+ obj <- decodeJson json
+ text <- obj .:? "#text"
+ mbid <- fromMaybe "" <$> obj .:? "mbid"
+ pure $ LastfmAlbum { text, mbid }
+
+newtype LastfmDate = LastfmDate { uts :: Int }
+
+derive instance genericLastfmDate :: Generic LastfmDate _
+instance showLastfmDate :: Show LastfmDate where
+ show = genericShow
+
+instance decodeJsonLastfmDate :: DecodeJson LastfmDate where
+ decodeJson json = do
+ obj <- decodeJson json
+ utsStr <- obj .: "uts"
+ case fromString utsStr of
+ Just n -> pure $ LastfmDate { uts: n }
+ Nothing -> Left $ TypeMismatch $ "Invalid uts: " <> utsStr
+
+newtype LastfmTrack = LastfmTrack
+ { name :: String
+ , artist :: LastfmArtist
+ , album :: Maybe LastfmAlbum
+ , date :: Maybe LastfmDate
+ }
+
+derive instance genericLastfmTrack :: Generic LastfmTrack _
+instance showLastfmTrack :: Show LastfmTrack where
+ show = genericShow
+
+instance decodeJsonLastfmTrack :: DecodeJson LastfmTrack where
+ decodeJson json = do
+ obj <- decodeJson json
+ name <- obj .: "name"
+ artist <- obj .: "artist"
+ album <- obj .:? "album"
+ date <- obj .:? "date"
+ pure $ LastfmTrack { name, artist, album, date }
+
newtype StatsEntry = StatsEntry
{ name :: String
, count :: Int
diff --git a/test/Main.purs b/test/Main.purs
@@ -14,10 +14,10 @@ import Data.String.Regex (regex, parseFlags)
import Test.Spec.Reporter.Console (consoleReporter)
import Test.Spec.Runner.Node (runSpecAndExitProcess)
import Types (Listen(..), ListenBrainzResponse(..), MbidMapping(..), Payload(..), Stats(..), StatsEntry(..), TrackMetadata(..), ListenBrainzSubmitPayload(..), ListenBrainzSubmitListen(..), ListenBrainzSubmitTrackMetadata(..), ListenBrainzAdditionalInfo(..))
-import Db (FilterField(..), connect, initDb, checkExists, upsertScrobble, getScrobbles, initReleaseMetadata, upsertReleaseMetadata, getStats, dbBaseName, getOldestTs, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleasesByMbids, touchGenreCheckedAt, getOrCreateToken, getTokenUser)
+import Db (FilterField(..), connect, initDb, checkExists, upsertScrobble, getScrobbles, initReleaseMetadata, upsertReleaseMetadata, getStats, dbBaseName, getOldestTs, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleasesByMbids, touchGenreCheckedAt, getOrCreateToken, getTokenUser, fromString)
import Data.Argonaut.Core (Json)
import Foreign.Object as Object
-import Main (parseFilterField, submitListenToListen, findUserByToken, sanitizeDate)
+import Main (submitListenToListen, findUserByToken, sanitizeDate)
import Cover (sanitizeKey)
import Sync (listenBrainzUrl, lastfmTrackToListen, parseLastfmResponse)
import S3 (getS3Url)
@@ -49,17 +49,17 @@ main = runSpecAndExitProcess [consoleReporter] do
sanitizeKey "a...b" `shouldEqual` "a...b"
sanitizeKey "UPPER lower" `shouldEqual` "UPPER_lower"
- describe "parseFilterField" do
+ describe "fromString" do
it "maps all valid field names" do
- parseFilterField "artist" `shouldEqual` Just FilterArtist
- parseFilterField "album" `shouldEqual` Just FilterAlbum
- parseFilterField "label" `shouldEqual` Just FilterLabel
- parseFilterField "year" `shouldEqual` Just FilterYear
- parseFilterField "genre" `shouldEqual` Just FilterGenre
+ fromString "artist" `shouldEqual` Just FilterArtist
+ fromString "album" `shouldEqual` Just FilterAlbum
+ fromString "label" `shouldEqual` Just FilterLabel
+ fromString "year" `shouldEqual` Just FilterYear
+ fromString "genre" `shouldEqual` Just FilterGenre
it "returns Nothing for unknown or empty input" do
- parseFilterField "unknown" `shouldEqual` Nothing
- parseFilterField "" `shouldEqual` Nothing
+ fromString "unknown" `shouldEqual` Nothing
+ fromString "" `shouldEqual` Nothing
describe "sanitizeDate" do
it "strips non-numeric characters except hyphens" do
