{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module MusicScroll.UIContext where import Control.Monad (forever, unless) import Data.GI.Gtk.Threading (postGUISync) import Data.Maybe (isNothing) import Data.Text as T import qualified GI.Gtk as Gtk import MusicScroll.LyricsPipeline import MusicScroll.Providers.Utils (Lyrics (..)) import MusicScroll.TrackInfo (TrackByPath (..), TrackInfo (..)) import Pipes data UIContext = UIContext { mainWindow :: Gtk.Window, titleLabel :: Gtk.Label, artistLabel :: Gtk.Label, lyricsTextView :: Gtk.TextView, errorLabel :: Gtk.Label, titleSuplementEntry :: Gtk.Entry, artistSuplementEntry :: Gtk.Entry, suplementAcceptButton :: Gtk.Button, suplementUpdateButton :: Gtk.Button, keepArtistNameCheck :: Gtk.CheckButton } errorMsg :: ErrorCause -> Text errorMsg (NotOnDB trackPath) | isNothing (tpArtist trackPath) = "No lyrics found by hash on the song file, try to suplement the song's\ \ artist metadata to try to get it from the web." | isNothing (tpTitle trackPath) = "No lyrics found by hash on the song file, try to suplement the song's\ \ title metadata to try to get it from the web." | otherwise = "This case should not happen" errorMsg ENoSong = "No song found, this is usually an intermediary state." errorMsg (NoLyricsOnWeb _) = "Lyrics provider didn't have that song." extractGuess :: ErrorCause -> Maybe (Text, Text) extractGuess (NoLyricsOnWeb (TrackInfo {..})) = pure (tTitle, tArtist) extractGuess (NotOnDB (TrackByPath {..})) = let def = maybe mempty id in pure (def tpTitle, def tpArtist) extractGuess _ = Nothing -- | Only usable inside a gtk context updateNewLyrics :: UIContext -> (TrackInfo, Lyrics) -> IO () updateNewLyrics ctx@(UIContext {..}) (track, Lyrics singleLyrics) = let !bytesToUpdate = fromIntegral $ T.length singleLyrics in postGUISync $ do Gtk.labelSetText errorLabel mempty Gtk.labelSetText titleLabel (tTitle track) Gtk.labelSetText artistLabel (tArtist track) lyricsBuffer <- Gtk.textViewGetBuffer lyricsTextView Gtk.textBufferSetText lyricsBuffer singleLyrics bytesToUpdate updateSuplementalGuess ctx (mempty, mempty) dischargeOnUI :: UIContext -> Consumer SearchResult IO a dischargeOnUI ctx = forever (dischargeOnUISingle ctx) dischargeOnUISingle :: UIContext -> Consumer SearchResult IO () dischargeOnUISingle ctx = do res <- await liftIO $ case res of GotLyric _ info lyr -> updateNewLyrics ctx (info, lyr) ErrorOn cause -> updateErrorCause ctx cause updateErrorCause :: UIContext -> ErrorCause -> IO () updateErrorCause ctx@(UIContext {..}) cause = postGUISync $ do Gtk.labelSetText titleLabel "No Song available" Gtk.labelSetText artistLabel mempty lyricsBuffer <- Gtk.textViewGetBuffer lyricsTextView Gtk.textBufferSetText lyricsBuffer mempty 0 Gtk.labelSetText errorLabel (errorMsg cause) maybe (return ()) (updateSuplementalGuess ctx) (extractGuess cause) updateSuplementalGuess :: UIContext -> (Text, Text) -> IO () updateSuplementalGuess (UIContext {..}) (guessTitle, guessArtist) = do Gtk.entrySetText titleSuplementEntry guessTitle shouldMaintainArtistSupl <- Gtk.getToggleButtonActive keepArtistNameCheck unless shouldMaintainArtistSupl $ Gtk.entrySetText artistSuplementEntry guessArtist