Determine album art dominant colors to reduce flicker in the interface

app/src/About.purs

@@ -101,6 +101,7 @@ updateScanStatus elems (ScanStatus status) =
         ScanPreProcessingThumbnails -> "Discovering existing thumbnails …"
         ScanGeneratingThumbnails    -> "Generating new thumbnails …"
         ScanLoadingThumbnails       -> "Loading thumbnails …"
+        ScanReloading               -> "Reloading data …"
         ScanDone                    -> "Scan complete"
 
     valuePair (show status.filesDiscovered) "files discovered"

app/src/AlbumListView.purs

@@ -141,6 +141,7 @@ renderAlbum :: (Event -> Aff Unit) -> Album -> Html Unit
 renderAlbum postEvent (Album album) = Html.div $ do
   Html.addClass "album"
   Html.img (Model.thumbUrl album.id) (album.title <> " by " <> album.artist) $ do
+    Html.setBackgroundColor album.color
     Html.addClass "thumb"
   Html.span $ do
     Html.addClass "title"

app/src/Dom.js

@@ -207,6 +207,12 @@ export const setMaskImageImpl = function(mask, element) {
   }
 }
 
+export const setBackgroundColorImpl = function(hexColor, element) {
+  return function() {
+    element.style.backgroundColor = hexColor;
+  }
+}
+
 export const setWidthImpl = function(width, element) {
   return function() {
     element.style.width = width;

app/src/Dom.purs

@@ -33,6 +33,7 @@ module Dom
   , renderHtml
   , scrollIntoView
   , setAttribute
+  , setBackgroundColor
   , setHeight
   , setId
   , setMaskImage
@@ -90,6 +91,7 @@ foreign import onScrollImpl :: Fn2 (Effect Unit) Element (Effect Unit)
 foreign import removeChildImpl :: Fn2 Element Element (Effect Unit)
 foreign import removeClassImpl :: Fn2 String Element (Effect Unit)
 foreign import setAttributeImpl :: Fn3 String String Element (Effect Unit)
+foreign import setBackgroundColorImpl :: Fn2 String Element (Effect Unit)
 foreign import setHeightImpl :: Fn2 String Element (Effect Unit)
 foreign import setIdImpl :: Fn2 String Element (Effect Unit)
 foreign import setMaskImageImpl :: Fn2 String Element (Effect Unit)
@@ -143,6 +145,9 @@ setMaskImage mask element = runFn2 setMaskImageImpl mask element
 setScrollTop :: Number -> Element -> Effect Unit
 setScrollTop off element = runFn2 setScrollTopImpl off element
 
+setBackgroundColor :: String -> Element -> Effect Unit
+setBackgroundColor hexColor element = runFn2 setBackgroundColorImpl hexColor element
+
 setAttribute :: String -> String -> Element -> Effect Unit
 setAttribute attribute value element = runFn3 setAttributeImpl attribute value element
 

app/src/Event.purs

@@ -8,13 +8,14 @@
 module Event
   ( Event (..)
   , HistoryMode (..)
+  , SearchSeq (..)
   , SortField (..)
   , SortDirection (..)
   , SortMode
   ) where
 
 import Prelude
-import Model (Album, QueuedTrack, ScanStatus)
+import Model (Album, QueuedTrack, ScanStatus, SearchResults)
 import Navigation (Location)
 
 data HistoryMode
@@ -36,6 +37,13 @@ data SortDirection
 
 type SortMode = { field :: SortField, direction :: SortDirection }
 
+-- Search queries contain a sequence number, so we can correlate results with
+-- searches and discard results for outdated queries.
+data SearchSeq = SearchSeq Int
+
+derive instance searchSeqEq :: Eq SearchSeq
+derive instance searchSeqOrd :: Ord SearchSeq
+
 data Event
   = Initialize (Array Album) (Array QueuedTrack)
   | UpdateQueue (Array QueuedTrack)
@@ -57,5 +65,11 @@ data Event
   | UpdateProgress
   -- The user typed the keyboard shortcut for 'search'.
   | SearchKeyPressed
+  -- The user searched for this query. Queries contain a sequence number
+  -- generated by the search box itself, so that we process results in the
+  -- right order, even when results or even query events arrive in a different
+  -- order.
+  | Search SearchSeq String
+  | SearchResult SearchSeq SearchResults
   -- A new scan status was received.
   | UpdateScanStatus ScanStatus

app/src/Html.purs

@@ -28,6 +28,7 @@ module Html
   , p
   , removeClass
   , scrollIntoView
+  , setBackgroundColor
   , setHeight
   , setId
   , setMaskImage
@@ -135,6 +136,13 @@ onInput callback = ReaderT $ \container ->
 scrollIntoView :: Html Unit
 scrollIntoView = ReaderT Dom.scrollIntoView
 
+-- Set the background color to the given hex color. Should not include the
+-- leading `#`, we prepend that here, to avoid having to store and transfer
+-- the additional byte.
+setBackgroundColor :: String -> Html Unit
+setBackgroundColor hexColor = ReaderT $
+  \container -> Dom.setBackgroundColor ("#" <> hexColor) container
+
 setScrollTop :: Number -> Html Unit
 setScrollTop off = ReaderT $ \container -> Dom.setScrollTop off container
 

app/src/Model.purs

@@ -138,6 +138,7 @@ newtype Album = Album
   , artistIds :: NonEmptyArray ArtistId
   , releaseDate :: String
   , firstSeen :: String
+  , color :: String
   , discoverScore :: Number
   , trendingScore :: Number
   , forNowScore :: Number
@@ -155,6 +156,7 @@ instance decodeJsonAlbum :: DecodeJson Album where
     artist        <- Json.getField obj "artist"
     releaseDate   <- Json.getField obj "release_date"
     firstSeen     <- Json.getField obj "first_seen"
+    color         <- Json.getField obj "color"
     discoverScore <- Json.getField obj "discover_score"
     trendingScore <- Json.getField obj "trending_score"
     forNowScore <- Json.getField obj "for_now_score"
@@ -165,6 +167,7 @@ instance decodeJsonAlbum :: DecodeJson Album where
       , artistIds
       , releaseDate
       , firstSeen
+      , color
       , discoverScore
       , trendingScore
       , forNowScore
@@ -294,6 +297,7 @@ data ScanStage
   | ScanPreProcessingThumbnails
   | ScanGeneratingThumbnails
   | ScanLoadingThumbnails
+  | ScanReloading
   | ScanDone
 
 derive instance eqScanStage :: Eq ScanStage
@@ -312,6 +316,7 @@ instance decodeJsonScanStage :: DecodeJson ScanStage where
       "preprocessing_thumbnails" -> pure ScanPreProcessingThumbnails
       "generating_thumbnails"    -> pure ScanGeneratingThumbnails
       "loading_thumbnails"       -> pure ScanLoadingThumbnails
+      "reloading"                -> pure ScanReloading
       "done"                     -> pure ScanDone
       _ -> Left $ UnexpectedValue json
 

app/src/Search.purs

@@ -10,55 +10,77 @@ module Search
   , new
   , focus
   , clear
+  , renderSearchResults
   ) where
 
 import Control.Monad.Reader.Class (ask, local)
 import Data.Array as Array
 import Data.Foldable (for_)
+import Data.Maybe (Maybe (..))
 import Data.String.CodeUnits as CodeUnits
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
-import Effect.Class.Console as Console
+import Foreign.Object (Object)
+import Foreign.Object as Object
 import Prelude
 
 import Dom (Element)
 import Dom as Dom
-import Event (Event, HistoryMode (RecordHistory))
+import Event (Event, HistoryMode (RecordHistory), SearchSeq (SearchSeq))
 import Event as Event
 import Html (Html)
 import Html as Html
-import Model (SearchArtist (..), SearchAlbum (..), SearchTrack (..))
+import Model (Album (..), AlbumId (..), SearchArtist (..), SearchAlbum (..), SearchResults (..), SearchTrack (..))
 import Model as Model
 import Navigation as Navigation
+import Var as Var
 
 type SearchElements =
   { searchBox :: Element
   , resultBox :: Element
   }
 
-renderSearchArtist :: (Event -> Aff Unit) -> SearchArtist -> Html Unit
-renderSearchArtist postEvent (SearchArtist artist) = do
+-- Look up the album by id in the album collection. If we found it, set the
+-- background color to that album's color. Intended to be curried.
+setAlbumColor :: Object Album -> AlbumId -> Html Unit
+setAlbumColor albumsById (AlbumId id) = case Object.lookup id albumsById of
+  Nothing -> pure unit
+  Just (Album album) -> Html.setBackgroundColor album.color
+
+renderSearchArtist
+  :: (Event -> Aff Unit)
+  -> (AlbumId -> Html Unit)
+  -> SearchArtist
+  -> Html Unit
+renderSearchArtist postEvent setColor (SearchArtist artist) = do
   Html.li $ do
     Html.addClass "artist"
     Html.div $ do
       Html.addClass "name"
       Html.text artist.name
     Html.div $ do
       Html.addClass "discography"
-      for_ artist.albums $ \albumId -> do
-        Html.img (Model.thumbUrl albumId) ("An album by " <> artist.name) $ pure unit
+      for_ artist.albums $ \albumId -> Html.img
+        (Model.thumbUrl albumId)
+        ("An album by " <> artist.name)
+        (setColor albumId)
 
     Html.onClick $ launchAff_ $ postEvent $ Event.NavigateTo
       (Navigation.Artist $ artist.id)
       RecordHistory
 
 -- TODO: Deduplicate between here and album component.
-renderSearchAlbum :: (Event -> Aff Unit) -> SearchAlbum -> Html Unit
-renderSearchAlbum postEvent (SearchAlbum album) = do
+renderSearchAlbum
+ :: (Event -> Aff Unit)
+ -> (AlbumId -> Html Unit)
+ -> SearchAlbum
+ -> Html Unit
+renderSearchAlbum postEvent setColor (SearchAlbum album) = do
   Html.li $ do
     Html.addClass "album"
     Html.img (Model.thumbUrl album.id) (album.title <> " by " <> album.artist) $ do
+      setColor album.id
       Html.addClass "thumb"
     Html.span $ do
       Html.addClass "title"
@@ -77,11 +99,16 @@ renderSearchAlbum postEvent (SearchAlbum album) = do
       (Navigation.Album $ album.id)
       RecordHistory
 
-renderSearchTrack :: (Event -> Aff Unit) -> SearchTrack -> Html Unit
-renderSearchTrack postEvent (SearchTrack track) = do
+renderSearchTrack
+  :: (Event -> Aff Unit)
+  -> (AlbumId -> Html Unit)
+  -> SearchTrack
+  -> Html Unit
+renderSearchTrack postEvent setColor (SearchTrack track) = do
   Html.li $ do
     Html.addClass "track"
     Html.img (Model.thumbUrl track.albumId) track.album $ do
+      setColor track.albumId
       Html.addClass "thumb"
     Html.span $ do
       Html.addClass "title"
@@ -107,47 +134,71 @@ new postEvent = do
     ask
 
   local (const searchBox) $ do
+    -- We maintain the search sequence number here, because the input handler
+    -- runs as an Effect rather than Aff, so we can be sure that the sequence
+    -- numbers match the order of the input events. In the main loop, we only
+    -- process search results if they are for a newer search than the last one
+    -- we processed, to ensure that a slow search query that arrives later does
+    -- not overwrite current search results. (That can happen especially at the
+    -- beginning, as a short query string matches more, so the response is
+    -- larger and takes longer to serialize/transfer/deserialize.)
+    searchSeq <- liftEffect $ Var.create 0
     Html.onInput $ \query -> do
-      -- Fire off the search query and render it when it comes in.
-      -- TODO: Pass these through the event loop, to ensure that the result
-      -- matches the query, and perhaps for caching as well.
-      launchAff_ $ do
-        Model.SearchResults result <- Model.search query
-        Console.log $ "Received artists: " <> (show $ Array.length $ result.artists)
-        Console.log $ "Received albums:  " <> (show $ Array.length $ result.albums)
-        Console.log $ "Received tracks:  " <> (show $ Array.length $ result.tracks)
-        liftEffect $ do
-          Html.withElement resultBox $ do
-            Html.clear
-            Html.div $ do
-              Html.addClass "search-results-list"
-
-              when (not $ Array.null result.artists) $ do
-                Html.div $ do
-                  Html.setId "search-artists"
-                  Html.h2 $ Html.text "Artists"
-                  -- Limit the number of results rendered at once to keep search
-                  -- responsive. TODO: Render overflow button.
-                  Html.ul $ for_ (Array.take 10 result.artists) $ renderSearchArtist postEvent
-
-              when (not $ Array.null result.albums) $ do
-                Html.div $ do
-                  Html.setId "search-albums"
-                  Html.h2 $ Html.text "Albums"
-                  -- Limit the number of results rendered at once to keep search
-                  -- responsive. TODO: Render overflow button.
-                  Html.ul $ for_ (Array.take 25 result.albums) $ renderSearchAlbum postEvent
-
-              when (not $ Array.null result.tracks) $ do
-                Html.div $ do
-                  Html.setId "search-tracks"
-                  Html.h2 $ Html.text "Tracks"
-                  -- Limit the number of results rendered at once to keep search
-                  -- responsive. TODO: Render overflow button.
-                  Html.ul $ for_ (Array.take 25 result.tracks) $ renderSearchTrack postEvent
+      currentSeq <- Var.get searchSeq
+      let nextSeq = currentSeq + 1
+      Var.set searchSeq nextSeq
+      launchAff_ $ postEvent $ Event.Search (SearchSeq nextSeq) query
 
   pure $ { searchBox, resultBox }
 
+renderSearchResults
+  :: (Event -> Aff Unit)
+  -> SearchElements
+  -> Object Album
+  -> SearchResults
+  -> Effect Unit
+renderSearchResults postEvent elements albumsById (SearchResults result) =
+  let
+    setColor = setAlbumColor albumsById
+  in
+    Html.withElement elements.resultBox $ do
+      -- TODO: On low-power devices, there can be a brief 1-frame flicker for
+      -- images to load after extending the query, even if the results were
+      -- visible previously -- presumably because we delete the nodes, so
+      -- Chromium deallocates the images, and has to decode them again when we
+      -- promptly add the <img> nodes again. We could do better by reycling
+      -- those image nodes.
+      Html.clear
+      Html.div $ do
+        Html.addClass "search-results-list"
+
+        when (not $ Array.null result.artists) $ do
+          Html.div $ do
+            Html.setId "search-artists"
+            Html.h2 $ Html.text "Artists"
+            -- Limit the number of results rendered at once to keep search
+            -- responsive. TODO: Render overflow button.
+            Html.ul $ for_ (Array.take 10 result.artists) $
+              renderSearchArtist postEvent setColor
+
+        when (not $ Array.null result.albums) $ do
+          Html.div $ do
+            Html.setId "search-albums"
+            Html.h2 $ Html.text "Albums"
+            -- Limit the number of results rendered at once to keep search
+            -- responsive. TODO: Render overflow button.
+            Html.ul $ for_ (Array.take 25 result.albums) $
+              renderSearchAlbum postEvent setColor
+
+        when (not $ Array.null result.tracks) $ do
+          Html.div $ do
+            Html.setId "search-tracks"
+            Html.h2 $ Html.text "Tracks"
+            -- Limit the number of results rendered at once to keep search
+            -- responsive. TODO: Render overflow button.
+            Html.ul $ for_ (Array.take 25 result.tracks) $
+              renderSearchTrack postEvent setColor
+
 clear :: SearchElements -> Effect Unit
 clear elements = do
   Dom.setValue "" elements.searchBox