UIEvent.hs

{-# language OverloadedStrings, RecordWildCards, BangPatterns #-}
module MusicScroll.UIEvent where

import           Control.Monad (unless)
import           Data.Maybe (isNothing)
import           Data.Text (Text)
import           Data.Text as T
import qualified GI.Gtk as Gtk
import           Data.GI.Gtk.Threading (postGUISync)

import           MusicScroll.TrackInfo (TrackInfo(..), TrackByPath(..))
import           MusicScroll.TagParsing (Lyrics(..))

data UIEvent = GotLyric TrackInfo Lyrics
             | ErrorOn ErrorCause

data ErrorCause = NotOnDB TrackByPath | NoLyricsOnWeb TrackInfo | ENoSong

data AppContext = AppContext
  { mainWindow     :: Gtk.Window
  , titleLabel     :: Gtk.Label
  , artistLabel    :: Gtk.Label
  , lyricsTextView :: Gtk.TextView
  , errorLabel     :: Gtk.Label
  , titleSuplementEntry   :: Gtk.Entry
  , artistSuplementEntry  :: Gtk.Entry
  , suplementAcceptButton :: 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 :: AppContext -> (TrackInfo, Lyrics) -> IO ()
updateNewLyrics ctx@(AppContext {..}) (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)

updateErrorCause :: AppContext -> ErrorCause -> IO ()
updateErrorCause ctx@(AppContext {..}) 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 :: AppContext -> (Text, Text) -> IO ()
updateSuplementalGuess (AppContext {..}) (guessTitle, guessArtist) =
  do Gtk.entrySetText titleSuplementEntry guessTitle
     shouldMaintainArtistSupl <- Gtk.getToggleButtonActive keepArtistNameCheck
     unless shouldMaintainArtistSupl $
       Gtk.entrySetText artistSuplementEntry guessArtist