movie-monad-0.0.5.0: src/FileChooser.hs

{-
  Movie Monad
  (C) 2017 David Lettier
  lettier.com
-}

{-# LANGUAGE OverloadedStrings #-}

module FileChooser where

import Control.Monad
import Data.Maybe
import Data.Int
import Data.Text
import Data.IORef
import qualified Network.URI
import qualified GI.Gdk
import qualified GI.Gtk
import qualified GI.Gst

import qualified Records as R
import Constants
import Reset
import Window
import ErrorMessage
import VideoInfo
import Playbin
import Uri
import Utils

addFileChooserHandlers :: R.Application -> IO ()
addFileChooserHandlers
  application@R.Application
    { R.guiObjects =
        R.GuiObjects
          { R.fileChooserButton = fileChooserButton
          , R.fileChooserDialog = fileChooserDialog
          , R.fileChooserWidget = fileChooserWidget
          , R.fileChooserEntry  = fileChooserEntry
          }
    }
  = do
  void $
    GI.Gtk.onWidgetButtonReleaseEvent fileChooserButton (fileChooserButtonClickHandler application)
  void $
    GI.Gtk.onDialogResponse fileChooserDialog (fileChooserDialogResponseHandler application)
  void $
    GI.Gtk.onFileChooserSelectionChanged fileChooserWidget (fileChooserSelectionChangedHandler application)
  void $
    GI.Gtk.onEntryIconRelease fileChooserEntry (\ _ _ -> GI.Gtk.entrySetText fileChooserEntry "")

fileChooserDialogResponseHandler :: R.Application -> Int32 -> IO ()
fileChooserDialogResponseHandler
  application@R.Application
    { R.guiObjects =
        guiObjects@R.GuiObjects
          { R.window                           = window
          , R.videoWidget                      = videoWidget
          , R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText
          , R.fileChooserEntry                 = fileChooserEntry
          , R.fileChooserButtonLabel           = fileChooserButtonLabel
          , R.volumeButton                     = volumeButton
          , R.errorMessageDialog               = errorMessageDialog
          , R.fileChooserDialog                = fileChooserDialog
          }
    , R.ioRefs =
        R.IORefs
          { R.isWindowFullScreenRef   = isWindowFullScreenRef
          , R.videoInfoRef            = videoInfoRef
          , R.previousFileNamePathRef = previousFileNamePathRef
          }
    , R.playbin = playbin
    }
  responseId
  = do
  GI.Gtk.widgetHide fileChooserDialog
  if enumToInt32 GI.Gtk.ResponseTypeOk == responseId
    then do
      filePathName  <- GI.Gtk.entryGetText fileChooserEntry
      maybeFileName <- setFileChooserButtonLabel fileChooserButtonLabel filePathName
      case maybeFileName of
        (Just _) -> do
          let filePathNameStr = Data.Text.unpack filePathName
          videoInfo           <- fromMaybe R.defaultVideoInfo <$> getVideoInfo videoInfoRef filePathNameStr
          desiredWindowWidth  <- getDesiredWindowWidth windowWidthSelectionComboBoxText window
          maybeWindowSize     <- calculateWindowSize guiObjects desiredWindowWidth videoInfo
          case maybeWindowSize of
            Just (width, height) -> do
              videoWidgetName <- GI.Gtk.widgetGetName videoWidget
              if videoWidgetName == invalidVideoWidgetName
                then do
                  resetApplication application
                  runErrorMessageDialog
                    errorMessageDialog
                    "Cannot play the video. Please install the bad plugins, version 1.8 or higher, for GStreamer version 1."
                else do
                  isWindowFullScreen <- readIORef isWindowFullScreenRef
                  setupWindowForPlayback
                    guiObjects
                    (R.isSeekable videoInfo)
                    isWindowFullScreen
                    width
                    height
                  saveVideoInfo videoInfoRef videoInfo
                  resetPlaybin playbin
                  setPlaybinUriAndVolume playbin filePathNameStr volumeButton
                  void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying
            _ -> do
              resetApplication application
              runErrorMessageDialog
                errorMessageDialog $
                  Data.Text.pack $
                  Prelude.concat ["\"", filePathNameStr, "\" is not a video."]
        _ ->
          resetApplication application
    else do
      filePathName <- readIORef previousFileNamePathRef
      fromMaybe R.defaultVideoInfo <$>
        getVideoInfo videoInfoRef (Data.Text.unpack filePathName) >>=
          saveVideoInfo videoInfoRef
      _ <- setFileChooserButtonLabel fileChooserButtonLabel filePathName
      GI.Gtk.entrySetText fileChooserEntry filePathName

fileChooserButtonClickHandler :: R.Application -> GI.Gdk.EventButton -> IO Bool
fileChooserButtonClickHandler
  R.Application
    { R.guiObjects =
        R.GuiObjects
          { R.fileChooserEntry = fileChooserEntry
          , R.fileChooserDialog = fileChooserDialog
          }
    , R.ioRefs =
        R.IORefs
          { R.previousFileNamePathRef = previousFileNamePathRef
          }
    }
  _
  = do
  text <- GI.Gtk.entryGetText fileChooserEntry
  atomicWriteIORef previousFileNamePathRef text
  _ <- GI.Gtk.dialogRun fileChooserDialog
  return True

fileChooserSelectionChangedHandler :: R.Application -> IO ()
fileChooserSelectionChangedHandler
  R.Application
    { R.guiObjects =
        R.GuiObjects
          { R.fileChooserWidget = fileChooserWidget
          , R.fileChooserEntry  = fileChooserEntry
          }
    , R.ioRefs =
        R.IORefs
          { R.videoInfoRef = videoInfoRef
          }
    }
  = do
  maybeUri <- GI.Gtk.fileChooserGetUri fileChooserWidget
  case maybeUri of
    Nothing -> return ()
    Just uri' -> do
      let uri = Network.URI.unEscapeString $ Data.Text.unpack uri'
      local <- isLocalFile uri
      video <- R.isVideo . fromMaybe R.defaultVideoInfo <$> getVideoInfo videoInfoRef uri
      GI.Gtk.entrySetText fileChooserEntry (if local && video then Data.Text.pack uri else "")

setFileChooserButtonLabel :: GI.Gtk.Label -> Data.Text.Text -> IO (Maybe Data.Text.Text)
setFileChooserButtonLabel fileChooserButtonLabel filePathName = do
  let fileName = fileNameFromFilePathName filePathName
  let fileNameEmpty = isTextEmpty fileName
  if fileNameEmpty
    then do
      GI.Gtk.labelSetText fileChooserButtonLabel "Open"
      return Nothing
    else do
      GI.Gtk.labelSetText fileChooserButtonLabel fileName
      return $ Just fileName