UI.hs

{-# language RecordWildCards, OverloadedStrings #-}
module MusicScroll.UI (uiThread, getSuplement) where

import           Control.Concurrent.STM (atomically)
import           Control.Concurrent.STM.TBQueue (TBQueue, writeTBQueue)
import           Control.Concurrent.STM.TMVar (TMVar, putTMVar)
import           Control.Concurrent.STM.TVar (TVar, writeTVar)
import           Data.GI.Gtk.Threading (setCurrentThreadAsGUIThread)
import           Data.Foldable (for_)
import           Data.Maybe (fromJust)
import           Data.Text (pack)
import qualified GI.Gtk as Gtk

import           MusicScroll.TrackSuplement
import           MusicScroll.UIContext
import           MusicScroll.Pipeline
import           MusicScroll.EventLoop

import           Paths_musicScroll


-- Remember to use Gtk.init Nothing before calling this.
getGtkScene :: IO UIContext
getGtkScene = do
  file    <- getDataFileName "app.glade"
  builder <- Gtk.builderNewFromFile (pack file)
  -- We *know* these ids are defined
  let getWidget wid id0 =
        Gtk.builderGetObject builder id0
          >>= Gtk.castTo wid . fromJust >>= return . fromJust
  UIContext <$> getWidget Gtk.Window "mainWindow"
            <*> getWidget Gtk.Label "titleLabel"
            <*> getWidget Gtk.Label "artistLabel"
            <*> getWidget Gtk.TextView "lyricsTextView"
            <*> getWidget Gtk.Label "errorLabel"
            <*> getWidget Gtk.Entry "titleSuplementEntry"
            <*> getWidget Gtk.Entry "artistSuplementEntry"
            <*> getWidget Gtk.Button "suplementAcceptButton"
            <*> getWidget Gtk.Button "suplementUpdateButton"
            <*> getWidget Gtk.CheckButton "keepArtistNameCheck"

uiThread :: TMVar UIContext -> TBQueue UICallback
         -> TVar (Maybe TrackSuplement) -> IO ()
uiThread ctxMVar outputTB suplTVar = do
  setCurrentThreadAsGUIThread
  _ <- Gtk.init Nothing
  appCtx@(UIContext {..}) <- getGtkScene
  atomically (putTMVar ctxMVar appCtx)
  Gtk.labelSetText titleLabel "MusicScroll"
  Gtk.widgetShowAll mainWindow
  _ <- Gtk.onButtonClicked suplementAcceptButton $
         getSuplement appCtx >>= \msupl -> do
           for_ msupl $ \supl ->
             let callback = suplementPipeline supl
             in atomically (writeTBQueue outputTB callback)
           atomically (writeTVar suplTVar msupl)
  _ <- Gtk.onButtonClicked suplementUpdateButton $
         getSuplement appCtx >>= \msupl -> do
           for_ msupl $ \supl ->
             let callback = updatePipeline supl
             in atomically (writeTBQueue outputTB callback)
           atomically (writeTVar suplTVar msupl)
  _ <- Gtk.afterWidgetFocusOutEvent artistSuplementEntry $
          const (defUpdate appCtx *> pure True)
  _ <- Gtk.afterToggleButtonToggled keepArtistNameCheck $ defUpdate appCtx
  _ <- Gtk.onWidgetDestroy mainWindow Gtk.mainQuit
  Gtk.main
  where
    defUpdate :: UIContext -> IO ()
    defUpdate c = getSuplement c >>= atomically . writeTVar suplTVar

getSuplement :: UIContext -> IO (Maybe TrackSuplement)
getSuplement (UIContext {..}) = trackSuplement <$>
  Gtk.entryGetText titleSuplementEntry
  <*> Gtk.entryGetText artistSuplementEntry
  <*> Gtk.getToggleButtonActive keepArtistNameCheck