{-# language CPP #-}

module Mpv.Process where

import Exon (exon)
import Path (Abs, File, Path, parent, relfile, toFilePath, (</>))
import qualified Path.IO as Path
import Path.IO (createTempDir, executable, getPermissions, getTempDir, removeDirRecur)
import System.Process.Typed (Process, ProcessConfig, proc, startProcess, stopProcess)

import qualified Mpv.Data.MpvError as MpvError
import Mpv.Data.MpvError (MpvError (MpvError))
import Mpv.Data.MpvProcessConfig (MpvProcessConfig (MpvProcessConfig))

#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
import Path (Rel)
#endif

tempSocket ::
  Member (Embed IO) r =>
  Sem r (Path Abs File)
tempSocket :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r (Path Abs File)
tempSocket = do
  Path Abs Dir
systemTmp <- Sem r (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getTempDir
  Path Abs Dir
dir <- Path Abs Dir -> String -> Sem r (Path Abs Dir)
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> String -> m (Path Abs Dir)
createTempDir Path Abs Dir
systemTmp String
"mpv-hs-"
  pure (Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|ipc|])

withTempSocketPath ::
  Members [Resource, Embed IO] r =>
  (Path Abs File -> Sem r a) ->
  Sem r a
withTempSocketPath :: forall (r :: [(* -> *) -> * -> *]) a.
Members '[Resource, Embed IO] r =>
(Path Abs File -> Sem r a) -> Sem r a
withTempSocketPath =
  Sem r (Path Abs File)
-> (Path Abs File -> Sem r (Either Text ()))
-> (Path Abs File -> Sem r a)
-> Sem r a
forall (r :: [(* -> *) -> * -> *]) a c b.
MemberWithError Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket Sem r (Path Abs File)
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r (Path Abs File)
tempSocket (IO () -> Sem r (Either Text ())
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (IO () -> Sem r (Either Text ()))
-> (Path Abs File -> IO ())
-> Path Abs File
-> Sem r (Either Text ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur (Path Abs Dir -> IO ())
-> (Path Abs File -> Path Abs Dir) -> Path Abs File -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent)

mpvProc ::
  Path Abs File ->
  Path Abs File ->
  ProcessConfig () () ()
mpvProc :: Path Abs File -> Path Abs File -> ProcessConfig () () ()
mpvProc Path Abs File
mpv Path Abs File
socket =
  String -> [String] -> ProcessConfig () () ()
proc (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
mpv) [
    [exon|--input-ipc-server=#{toFilePath socket}|],
    Item [String]
"--idle=once",
    Item [String]
"--no-terminal"
  ]

findExecutable ::
  Members [Error MpvError, Embed IO] r =>
  Maybe (Path Abs File) ->
  Sem r (Path Abs File)
findExecutable :: forall (r :: [(* -> *) -> * -> *]).
Members '[Error MpvError, Embed IO] r =>
Maybe (Path Abs File) -> Sem r (Path Abs File)
findExecutable = \case
  Just Path Abs File
path -> do
    IO Permissions -> Sem r (Either Text Permissions)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (Path Abs File -> IO Permissions
forall (m :: * -> *) b t. MonadIO m => Path b t -> m Permissions
getPermissions Path Abs File
path) Sem r (Either Text Permissions)
-> (Either Text Permissions -> Sem r (Path Abs File))
-> Sem r (Path Abs File)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (Permissions -> Bool
executable -> Bool
True) ->
        Path Abs File -> Sem r (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
path
      Right Permissions
_ ->
        MpvError -> Sem r (Path Abs File)
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw MpvError
notExecutable
      Left Text
_ ->
        MpvError -> Sem r (Path Abs File)
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw MpvError
notExist
    where
      notExist :: MpvError
notExist =
        Text -> MpvError
MpvError [exon|specified mpv path is not a readable file: #{show path}|]
      notExecutable :: MpvError
notExecutable =
        Text -> MpvError
MpvError [exon|specified mpv path is not executable: #{show path}|]
  Maybe (Path Abs File)
Nothing ->
    IO (Maybe (Path Abs File))
-> Sem r (Either Text (Maybe (Path Abs File)))
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (Path Rel File -> IO (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Rel File -> m (Maybe (Path Abs File))
Path.findExecutable [relfile|mpv|]) Sem r (Either Text (Maybe (Path Abs File)))
-> (Either Text (Maybe (Path Abs File)) -> Sem r (Path Abs File))
-> Sem r (Path Abs File)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (Just Path Abs File
path) ->
        Path Abs File -> Sem r (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
path
      Either Text (Maybe (Path Abs File))
_ ->
        MpvError -> Sem r (Path Abs File)
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (Text -> MpvError
MpvError Text
"could not find mpv executable in $PATH.")

startMpvProcess ::
  Members [Reader MpvProcessConfig, Embed IO, Final IO] r =>
  Path Abs File ->
  Sem r (Either MpvError (Process () () ()))
startMpvProcess :: forall (r :: [(* -> *) -> * -> *]).
Members '[Reader MpvProcessConfig, Embed IO, Final IO] r =>
Path Abs File -> Sem r (Either MpvError (Process () () ()))
startMpvProcess Path Abs File
socket =
  Sem (Error MpvError : r) (Process () () ())
-> Sem r (Either MpvError (Process () () ()))
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError do
    MpvProcessConfig Maybe (Path Abs File)
path <- Sem (Error MpvError : r) MpvProcessConfig
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
ask
    Path Abs File
validatedPath <- Maybe (Path Abs File) -> Sem (Error MpvError : r) (Path Abs File)
forall (r :: [(* -> *) -> * -> *]).
Members '[Error MpvError, Embed IO] r =>
Maybe (Path Abs File) -> Sem r (Path Abs File)
findExecutable Maybe (Path Abs File)
path
    forall exc err (r :: [(* -> *) -> * -> *]) a.
(Exception exc, Member (Error err) r, Member (Embed IO) r) =>
(exc -> err) -> IO a -> Sem r a
fromExceptionVia @SomeException (Text -> MpvError
MpvError.Fatal (Text -> MpvError)
-> (SomeException -> Text) -> SomeException -> MpvError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Text
forall b a. (Show a, IsString b) => a -> b
show) (ProcessConfig () () () -> IO (Process () () ())
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess (Path Abs File -> Path Abs File -> ProcessConfig () () ()
mpvProc Path Abs File
validatedPath Path Abs File
socket))

kill ::
  Members [Embed IO, Final IO] r =>
  Either MpvError (Process () () ()) ->
  Sem r ()
kill :: forall (r :: [(* -> *) -> * -> *]).
Members '[Embed IO, Final IO] r =>
Either MpvError (Process () () ()) -> Sem r ()
kill =
  (Process () () () -> Sem r (Either Text ()))
-> Either MpvError (Process () () ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> Sem r (Either Text ())
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (IO () -> Sem r (Either Text ()))
-> (Process () () () -> IO ())
-> Process () () ()
-> Sem r (Either Text ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess)

withMpvProcess ::
  Members [Reader MpvProcessConfig, Resource, Embed IO, Final IO] r =>
  Path Abs File ->
  (Either MpvError (Process () () ()) -> Sem r a) ->
  Sem r a
withMpvProcess :: forall (r :: [(* -> *) -> * -> *]) a.
Members
  '[Reader MpvProcessConfig, Resource, Embed IO, Final IO] r =>
Path Abs File
-> (Either MpvError (Process () () ()) -> Sem r a) -> Sem r a
withMpvProcess Path Abs File
socket =
  Sem r (Either MpvError (Process () () ()))
-> (Either MpvError (Process () () ()) -> Sem r ())
-> (Either MpvError (Process () () ()) -> Sem r a)
-> Sem r a
forall (r :: [(* -> *) -> * -> *]) a c b.
MemberWithError Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket (Path Abs File -> Sem r (Either MpvError (Process () () ()))
forall (r :: [(* -> *) -> * -> *]).
Members '[Reader MpvProcessConfig, Embed IO, Final IO] r =>
Path Abs File -> Sem r (Either MpvError (Process () () ()))
startMpvProcess Path Abs File
socket) Either MpvError (Process () () ()) -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members '[Embed IO, Final IO] r =>
Either MpvError (Process () () ()) -> Sem r ()
kill