{-# 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
  { UIContext -> Window
mainWindow :: Gtk.Window,
    UIContext -> Label
titleLabel :: Gtk.Label,
    UIContext -> Label
artistLabel :: Gtk.Label,
    UIContext -> TextView
lyricsTextView :: Gtk.TextView,
    UIContext -> Label
errorLabel :: Gtk.Label,
    UIContext -> Entry
titleSuplementEntry :: Gtk.Entry,
    UIContext -> Entry
artistSuplementEntry :: Gtk.Entry,
    UIContext -> Button
suplementAcceptButton :: Gtk.Button,
    UIContext -> Button
suplementUpdateButton :: Gtk.Button,
    UIContext -> CheckButton
keepArtistNameCheck :: Gtk.CheckButton
  }

errorMsg :: ErrorCause -> Text
errorMsg :: ErrorCause -> Text
errorMsg (NotOnDB TrackByPath
trackPath)
  | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (TrackByPath -> Maybe Text
tpArtist TrackByPath
trackPath) =
    Text
"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."
  | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (TrackByPath -> Maybe Text
tpTitle TrackByPath
trackPath) =
    Text
"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."
  | Bool
otherwise = Text
"This case should not happen"
errorMsg ErrorCause
ENoSong = Text
"No song found, this is usually an intermediary state."
errorMsg (NoLyricsOnWeb TrackInfo
_) = Text
"Lyrics provider didn't have that song."

extractGuess :: ErrorCause -> Maybe (Text, Text)
extractGuess :: ErrorCause -> Maybe (Text, Text)
extractGuess (NoLyricsOnWeb (TrackInfo {SongFilePath
Text
tTitle :: Text
tArtist :: Text
tUrl :: SongFilePath
tTitle :: TrackInfo -> Text
tArtist :: TrackInfo -> Text
tUrl :: TrackInfo -> SongFilePath
..})) = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
tTitle, Text
tArtist)
extractGuess (NotOnDB (TrackByPath {SongFilePath
Maybe Text
tpArtist :: TrackByPath -> Maybe Text
tpTitle :: TrackByPath -> Maybe Text
tpPath :: SongFilePath
tpTitle :: Maybe Text
tpArtist :: Maybe Text
tpPath :: TrackByPath -> SongFilePath
..})) =
  let def :: Maybe Text -> Text
def = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty Text -> Text
forall a. a -> a
id in (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Text
def Maybe Text
tpTitle, Maybe Text -> Text
def Maybe Text
tpArtist)
extractGuess ErrorCause
_ = Maybe (Text, Text)
forall a. Maybe a
Nothing

-- | Only usable inside a gtk context
updateNewLyrics :: UIContext -> (TrackInfo, Lyrics) -> IO ()
updateNewLyrics :: UIContext -> (TrackInfo, Lyrics) -> IO ()
updateNewLyrics ctx :: UIContext
ctx@(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
..}) (TrackInfo
track, Lyrics Text
singleLyrics) =
  let !bytesToUpdate :: Int32
bytesToUpdate = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
singleLyrics
   in IO () -> IO ()
forall a. IO a -> IO a
postGUISync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetText Label
errorLabel Text
forall a. Monoid a => a
mempty
        Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetText Label
titleLabel (TrackInfo -> Text
tTitle TrackInfo
track)
        Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetText Label
artistLabel (TrackInfo -> Text
tArtist TrackInfo
track)
        TextBuffer
lyricsBuffer <- TextView -> IO TextBuffer
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextView a) =>
a -> m TextBuffer
Gtk.textViewGetBuffer TextView
lyricsTextView
        TextBuffer -> Text -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Text -> Int32 -> m ()
Gtk.textBufferSetText TextBuffer
lyricsBuffer Text
singleLyrics Int32
bytesToUpdate
        UIContext -> (Text, Text) -> IO ()
updateSuplementalGuess UIContext
ctx (Text
forall a. Monoid a => a
mempty, Text
forall a. Monoid a => a
mempty)

dischargeOnUI :: UIContext -> Consumer SearchResult IO a
dischargeOnUI :: forall a. UIContext -> Consumer SearchResult IO a
dischargeOnUI UIContext
ctx = Proxy () SearchResult () X IO () -> Proxy () SearchResult () X IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (UIContext -> Proxy () SearchResult () X IO ()
dischargeOnUISingle UIContext
ctx)

dischargeOnUISingle :: UIContext -> Consumer SearchResult IO ()
dischargeOnUISingle :: UIContext -> Proxy () SearchResult () X IO ()
dischargeOnUISingle UIContext
ctx = do
  SearchResult
res <- Proxy () SearchResult () X IO SearchResult
Consumer' SearchResult IO SearchResult
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
  IO () -> Proxy () SearchResult () X IO ()
forall a. IO a -> Proxy () SearchResult () X IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Proxy () SearchResult () X IO ())
-> IO () -> Proxy () SearchResult () X IO ()
forall a b. (a -> b) -> a -> b
$ case SearchResult
res of
    GotLyric SongByOrigin
_ TrackInfo
info Lyrics
lyr -> UIContext -> (TrackInfo, Lyrics) -> IO ()
updateNewLyrics UIContext
ctx (TrackInfo
info, Lyrics
lyr)
    ErrorOn ErrorCause
cause -> UIContext -> ErrorCause -> IO ()
updateErrorCause UIContext
ctx ErrorCause
cause

updateErrorCause :: UIContext -> ErrorCause -> IO ()
updateErrorCause :: UIContext -> ErrorCause -> IO ()
updateErrorCause ctx :: UIContext
ctx@(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
..}) ErrorCause
cause = IO () -> IO ()
forall a. IO a -> IO a
postGUISync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  do
    Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetText Label
titleLabel Text
"No Song available"
    Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetText Label
artistLabel Text
forall a. Monoid a => a
mempty
    TextBuffer
lyricsBuffer <- TextView -> IO TextBuffer
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextView a) =>
a -> m TextBuffer
Gtk.textViewGetBuffer TextView
lyricsTextView
    TextBuffer -> Text -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
a -> Text -> Int32 -> m ()
Gtk.textBufferSetText TextBuffer
lyricsBuffer Text
forall a. Monoid a => a
mempty Int32
0
    Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetText Label
errorLabel (ErrorCause -> Text
errorMsg ErrorCause
cause)
    IO () -> ((Text, Text) -> IO ()) -> Maybe (Text, Text) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (UIContext -> (Text, Text) -> IO ()
updateSuplementalGuess UIContext
ctx) (ErrorCause -> Maybe (Text, Text)
extractGuess ErrorCause
cause)

updateSuplementalGuess :: UIContext -> (Text, Text) -> IO ()
updateSuplementalGuess :: UIContext -> (Text, Text) -> IO ()
updateSuplementalGuess (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
guessTitle, Text
guessArtist) =
  do
    Entry -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Text -> m ()
Gtk.entrySetText Entry
titleSuplementEntry Text
guessTitle
    Bool
shouldMaintainArtistSupl <- CheckButton -> IO Bool
forall (m :: * -> *) o.
(MonadIO m, IsToggleButton o) =>
o -> m Bool
Gtk.getToggleButtonActive CheckButton
keepArtistNameCheck
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
shouldMaintainArtistSupl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Entry -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> Text -> m ()
Gtk.entrySetText Entry
artistSuplementEntry Text
guessArtist