{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

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.Foldable (for_)
import Data.GI.Gtk.Threading (setCurrentThreadAsGUIThread)
import Data.Maybe (fromJust)
import Data.Text (pack)
import qualified GI.Gtk as Gtk
import MusicScroll.EventLoop
import MusicScroll.Pipeline
import MusicScroll.TrackSuplement
import MusicScroll.UIContext
import Paths_musicScroll

-- Remember to use Gtk.init Nothing before calling this.
getGtkScene :: IO UIContext
getGtkScene :: IO UIContext
getGtkScene = do
  FilePath
file <- FilePath -> IO FilePath
getDataFileName FilePath
"app.glade"
  Builder
builder <- Text -> IO Builder
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m Builder
Gtk.builderNewFromFile (FilePath -> Text
pack FilePath
file)
  -- We *know* these ids are defined
  let getWidget :: (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr b -> b
wid Text
id0 =
        Builder -> Text -> IO (Maybe Object)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBuilder a) =>
a -> Text -> m (Maybe Object)
Gtk.builderGetObject Builder
builder Text
id0
          IO (Maybe Object) -> (Maybe Object -> IO (Maybe b)) -> IO (Maybe b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr b -> b) -> Object -> IO (Maybe b)
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o', GObject o') =>
(ManagedPtr o' -> o') -> o -> IO (Maybe o')
Gtk.castTo ManagedPtr b -> b
wid (Object -> IO (Maybe b))
-> (Maybe Object -> Object) -> Maybe Object -> IO (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Object -> Object
forall a. HasCallStack => Maybe a -> a
fromJust
          IO (Maybe b) -> (Maybe b -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> (Maybe b -> b) -> Maybe b -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust
  Window
-> Label
-> Label
-> TextView
-> Label
-> Entry
-> Entry
-> Button
-> Button
-> CheckButton
-> UIContext
UIContext (Window
 -> Label
 -> Label
 -> TextView
 -> Label
 -> Entry
 -> Entry
 -> Button
 -> Button
 -> CheckButton
 -> UIContext)
-> IO Window
-> IO
     (Label
      -> Label
      -> TextView
      -> Label
      -> Entry
      -> Entry
      -> Button
      -> Button
      -> CheckButton
      -> UIContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Window -> Window) -> Text -> IO Window
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Window -> Window
Gtk.Window Text
"mainWindow"
    IO
  (Label
   -> Label
   -> TextView
   -> Label
   -> Entry
   -> Entry
   -> Button
   -> Button
   -> CheckButton
   -> UIContext)
-> IO Label
-> IO
     (Label
      -> TextView
      -> Label
      -> Entry
      -> Entry
      -> Button
      -> Button
      -> CheckButton
      -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr Label -> Label) -> Text -> IO Label
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Label -> Label
Gtk.Label Text
"titleLabel"
    IO
  (Label
   -> TextView
   -> Label
   -> Entry
   -> Entry
   -> Button
   -> Button
   -> CheckButton
   -> UIContext)
-> IO Label
-> IO
     (TextView
      -> Label
      -> Entry
      -> Entry
      -> Button
      -> Button
      -> CheckButton
      -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr Label -> Label) -> Text -> IO Label
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Label -> Label
Gtk.Label Text
"artistLabel"
    IO
  (TextView
   -> Label
   -> Entry
   -> Entry
   -> Button
   -> Button
   -> CheckButton
   -> UIContext)
-> IO TextView
-> IO
     (Label
      -> Entry -> Entry -> Button -> Button -> CheckButton -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr TextView -> TextView) -> Text -> IO TextView
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr TextView -> TextView
Gtk.TextView Text
"lyricsTextView"
    IO
  (Label
   -> Entry -> Entry -> Button -> Button -> CheckButton -> UIContext)
-> IO Label
-> IO
     (Entry -> Entry -> Button -> Button -> CheckButton -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr Label -> Label) -> Text -> IO Label
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Label -> Label
Gtk.Label Text
"errorLabel"
    IO (Entry -> Entry -> Button -> Button -> CheckButton -> UIContext)
-> IO Entry
-> IO (Entry -> Button -> Button -> CheckButton -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr Entry -> Entry) -> Text -> IO Entry
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Entry -> Entry
Gtk.Entry Text
"titleSuplementEntry"
    IO (Entry -> Button -> Button -> CheckButton -> UIContext)
-> IO Entry -> IO (Button -> Button -> CheckButton -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr Entry -> Entry) -> Text -> IO Entry
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Entry -> Entry
Gtk.Entry Text
"artistSuplementEntry"
    IO (Button -> Button -> CheckButton -> UIContext)
-> IO Button -> IO (Button -> CheckButton -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr Button -> Button) -> Text -> IO Button
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Button -> Button
Gtk.Button Text
"suplementAcceptButton"
    IO (Button -> CheckButton -> UIContext)
-> IO Button -> IO (CheckButton -> UIContext)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr Button -> Button) -> Text -> IO Button
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr Button -> Button
Gtk.Button Text
"suplementUpdateButton"
    IO (CheckButton -> UIContext) -> IO CheckButton -> IO UIContext
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ManagedPtr CheckButton -> CheckButton) -> Text -> IO CheckButton
forall {b}. GObject b => (ManagedPtr b -> b) -> Text -> IO b
getWidget ManagedPtr CheckButton -> CheckButton
Gtk.CheckButton Text
"keepArtistNameCheck"

uiThread ::
  TMVar UIContext ->
  TBQueue UICallback ->
  TVar (Maybe TrackSuplement) ->
  IO ()
uiThread :: TMVar UIContext
-> TBQueue UICallback -> TVar (Maybe TrackSuplement) -> IO ()
uiThread TMVar UIContext
ctxMVar TBQueue UICallback
outputTB TVar (Maybe TrackSuplement)
suplTVar = do
  IO ()
setCurrentThreadAsGUIThread
  Maybe [Text]
_ <- Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Text] -> m (Maybe [Text])
Gtk.init Maybe [Text]
forall a. Maybe a
Nothing
  appCtx :: UIContext
appCtx@(UIContext {Entry
Window
TextView
Label
Button
CheckButton
mainWindow :: Window
titleLabel :: Label
artistLabel :: Label
lyricsTextView :: TextView
errorLabel :: Label
titleSuplementEntry :: Entry
artistSuplementEntry :: Entry
suplementAcceptButton :: Button
suplementUpdateButton :: Button
keepArtistNameCheck :: CheckButton
mainWindow :: UIContext -> Window
titleLabel :: UIContext -> Label
artistLabel :: UIContext -> Label
lyricsTextView :: UIContext -> TextView
errorLabel :: UIContext -> Label
titleSuplementEntry :: UIContext -> Entry
artistSuplementEntry :: UIContext -> Entry
suplementAcceptButton :: UIContext -> Button
suplementUpdateButton :: UIContext -> Button
keepArtistNameCheck :: UIContext -> CheckButton
..}) <- IO UIContext
getGtkScene
  STM () -> IO ()
forall a. STM a -> IO a
atomically (TMVar UIContext -> UIContext -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar UIContext
ctxMVar UIContext
appCtx)
  Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetText Label
titleLabel Text
"MusicScroll"
  Window -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShowAll Window
mainWindow
  SignalHandlerId
_ <-
    Button -> ((?self::Button) => IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsButton a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
Gtk.onButtonClicked Button
suplementAcceptButton (((?self::Button) => IO ()) -> IO SignalHandlerId)
-> ((?self::Button) => IO ()) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$
      UIContext -> IO (Maybe TrackSuplement)
getSuplement UIContext
appCtx IO (Maybe TrackSuplement)
-> (Maybe TrackSuplement -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe TrackSuplement
msupl -> do
        Maybe TrackSuplement -> (TrackSuplement -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TrackSuplement
msupl ((TrackSuplement -> IO ()) -> IO ())
-> (TrackSuplement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TrackSuplement
supl ->
          let callback :: UICallback
callback = TrackSuplement -> UICallback
suplementPipeline TrackSuplement
supl
           in STM () -> IO ()
forall a. STM a -> IO a
atomically (TBQueue UICallback -> UICallback -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue UICallback
outputTB UICallback
callback)
        STM () -> IO ()
forall a. STM a -> IO a
atomically (TVar (Maybe TrackSuplement) -> Maybe TrackSuplement -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe TrackSuplement)
suplTVar Maybe TrackSuplement
msupl)
  SignalHandlerId
_ <-
    Button -> ((?self::Button) => IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsButton a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
Gtk.onButtonClicked Button
suplementUpdateButton (((?self::Button) => IO ()) -> IO SignalHandlerId)
-> ((?self::Button) => IO ()) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$
      UIContext -> IO (Maybe TrackSuplement)
getSuplement UIContext
appCtx IO (Maybe TrackSuplement)
-> (Maybe TrackSuplement -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe TrackSuplement
msupl -> do
        Maybe TrackSuplement -> (TrackSuplement -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TrackSuplement
msupl ((TrackSuplement -> IO ()) -> IO ())
-> (TrackSuplement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TrackSuplement
supl ->
          let callback :: UICallback
callback = TrackSuplement -> UICallback
updatePipeline TrackSuplement
supl
           in STM () -> IO ()
forall a. STM a -> IO a
atomically (TBQueue UICallback -> UICallback -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue UICallback
outputTB UICallback
callback)
        STM () -> IO ()
forall a. STM a -> IO a
atomically (TVar (Maybe TrackSuplement) -> Maybe TrackSuplement -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe TrackSuplement)
suplTVar Maybe TrackSuplement
msupl)
  SignalHandlerId
_ <-
    Entry
-> ((?self::Entry) => WidgetFocusOutEventCallback)
-> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a
-> ((?self::a) => WidgetFocusOutEventCallback) -> m SignalHandlerId
Gtk.afterWidgetFocusOutEvent Entry
artistSuplementEntry (((?self::Entry) => WidgetFocusOutEventCallback)
 -> IO SignalHandlerId)
-> ((?self::Entry) => WidgetFocusOutEventCallback)
-> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$
      IO Bool -> WidgetFocusOutEventCallback
forall a b. a -> b -> a
const (UIContext -> IO ()
defUpdate UIContext
appCtx IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
  SignalHandlerId
_ <- CheckButton
-> ((?self::CheckButton) => IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsToggleButton a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
Gtk.afterToggleButtonToggled CheckButton
keepArtistNameCheck (((?self::CheckButton) => IO ()) -> IO SignalHandlerId)
-> ((?self::CheckButton) => IO ()) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ UIContext -> IO ()
defUpdate UIContext
appCtx
  SignalHandlerId
_ <- Window -> ((?self::Window) => IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
Gtk.onWidgetDestroy Window
mainWindow IO ()
(?self::Window) => IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
Gtk.mainQuit
  IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
Gtk.main
  where
    defUpdate :: UIContext -> IO ()
    defUpdate :: UIContext -> IO ()
defUpdate UIContext
c = UIContext -> IO (Maybe TrackSuplement)
getSuplement UIContext
c IO (Maybe TrackSuplement)
-> (Maybe TrackSuplement -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> (Maybe TrackSuplement -> STM ())
-> Maybe TrackSuplement
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Maybe TrackSuplement) -> Maybe TrackSuplement -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe TrackSuplement)
suplTVar

getSuplement :: UIContext -> IO (Maybe TrackSuplement)
getSuplement :: UIContext -> IO (Maybe TrackSuplement)
getSuplement (UIContext {Entry
Window
TextView
Label
Button
CheckButton
mainWindow :: UIContext -> Window
titleLabel :: UIContext -> Label
artistLabel :: UIContext -> Label
lyricsTextView :: UIContext -> TextView
errorLabel :: UIContext -> Label
titleSuplementEntry :: UIContext -> Entry
artistSuplementEntry :: UIContext -> Entry
suplementAcceptButton :: UIContext -> Button
suplementUpdateButton :: UIContext -> Button
keepArtistNameCheck :: UIContext -> CheckButton
mainWindow :: Window
titleLabel :: Label
artistLabel :: Label
lyricsTextView :: TextView
errorLabel :: Label
titleSuplementEntry :: Entry
artistSuplementEntry :: Entry
suplementAcceptButton :: Button
suplementUpdateButton :: Button
keepArtistNameCheck :: CheckButton
..}) =
  Text -> Text -> Bool -> Maybe TrackSuplement
trackSuplement
    (Text -> Text -> Bool -> Maybe TrackSuplement)
-> IO Text -> IO (Text -> Bool -> Maybe TrackSuplement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entry -> IO Text
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Text
Gtk.entryGetText Entry
titleSuplementEntry
    IO (Text -> Bool -> Maybe TrackSuplement)
-> IO Text -> IO (Bool -> Maybe TrackSuplement)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Entry -> IO Text
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Text
Gtk.entryGetText Entry
artistSuplementEntry
    IO (Bool -> Maybe TrackSuplement)
-> IO Bool -> IO (Maybe TrackSuplement)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CheckButton -> IO Bool
forall (m :: * -> *) o.
(MonadIO m, IsToggleButton o) =>
o -> m Bool
Gtk.getToggleButtonActive CheckButton
keepArtistNameCheck