{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# LANGUAGE CPP #-}

module Test.Sandwich.WebDriver.Video.Internal (
  getVideoArgs
  , videoExtension
  ) where

import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Control.Monad.Reader
import Data.String.Interpolate
import System.FilePath
import System.Process
import Test.Sandwich
import Test.Sandwich.WebDriver.Internal.Binaries.Ffmpeg
import Test.Sandwich.WebDriver.Internal.OnDemand
import Test.Sandwich.WebDriver.Internal.Types
import Test.Sandwich.WebDriver.Types
import Test.Sandwich.WebDriver.Video.Types

#ifdef darwin_HOST_OS
getMacScreenNumber :: IO (Maybe Int)
getMacScreenNumber = return $ Just 0 -- TODO
#endif

#ifdef linux_HOST_OS
import Data.Function ((&), on)
import qualified Data.List as L
import Data.Maybe
import UnliftIO.Environment
#endif


videoExtension :: String
videoExtension :: String
videoExtension = String
"avi"

getVideoArgs :: (
  MonadUnliftIO m, MonadLoggerIO m, MonadMask m
  , MonadReader context m, HasBaseContext context, HasWebDriverContext context
  ) => FilePath -> (Word, Word, Int, Int) -> VideoSettings -> Maybe XvfbSession -> m (CreateProcess, FilePath)
getVideoArgs :: forall (m :: * -> *) context.
(MonadUnliftIO m, MonadLoggerIO m, MonadMask m,
 MonadReader context m, HasBaseContext context,
 HasWebDriverContext context) =>
String
-> (Word, Word, Int, Int)
-> VideoSettings
-> Maybe XvfbSession
-> m (CreateProcess, String)
getVideoArgs String
path (Word
width, Word
height, Int
x, Int
y) (VideoSettings {Bool
[String]
xcbgrabOptions :: [String]
avfoundationOptions :: [String]
gdigrabOptions :: [String]
hideMouseWhenRecording :: Bool
logToDisk :: Bool
xcbgrabOptions :: VideoSettings -> [String]
avfoundationOptions :: VideoSettings -> [String]
gdigrabOptions :: VideoSettings -> [String]
hideMouseWhenRecording :: VideoSettings -> Bool
logToDisk :: VideoSettings -> Bool
..}) Maybe XvfbSession
maybeXvfbSession = do
  WebDriver {MVar (OnDemand String)
wdFfmpeg :: MVar (OnDemand String)
wdFfmpeg :: WebDriver -> MVar (OnDemand String)
wdFfmpeg, FfmpegToUse
wdFfmpegToUse :: FfmpegToUse
wdFfmpegToUse :: WebDriver -> FfmpegToUse
wdFfmpegToUse} <- Label "webdriver" WebDriver -> m WebDriver
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "webdriver" WebDriver
webdriver
  String
ffmpeg <- MVar (OnDemand String) -> m (Either Text String) -> m String
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
MVar (OnDemand a) -> m (Either Text a) -> m a
getOnDemand MVar (OnDemand String)
wdFfmpeg (FfmpegToUse -> m (Either Text String)
forall context (m :: * -> *).
(MonadReader context m, HasBaseContext context, MonadUnliftIO m,
 MonadLoggerIO m, MonadMask m) =>
FfmpegToUse -> m (Either Text String)
obtainFfmpeg FfmpegToUse
wdFfmpegToUse)

#ifdef linux_HOST_OS
  String
displayNum <- case Maybe XvfbSession
maybeXvfbSession of
    Maybe XvfbSession
Nothing -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> m (Maybe String) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
lookupEnv String
"DISPLAY")
    Just (XvfbSession {Int
xvfbDisplayNum :: Int
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum}) -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
xvfbDisplayNum

  [(String, String)]
baseEnv <- m [(String, String)]
forall (m :: * -> *). MonadIO m => m [(String, String)]
getEnvironment

  let env :: [(String, String)]
env = case Maybe XvfbSession
maybeXvfbSession of
        Maybe XvfbSession
Nothing -> [(String, String)]
baseEnv
        Just (XvfbSession {Int
String
Maybe ProcessHandle
(Int, Int)
ProcessHandle
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum :: Int
xvfbXauthority :: String
xvfbDimensions :: (Int, Int)
xvfbProcess :: ProcessHandle
xvfbFluxboxProcess :: Maybe ProcessHandle
xvfbXauthority :: XvfbSession -> String
xvfbDimensions :: XvfbSession -> (Int, Int)
xvfbProcess :: XvfbSession -> ProcessHandle
xvfbFluxboxProcess :: XvfbSession -> Maybe ProcessHandle
..}) -> [(String, String)]
baseEnv
          [(String, String)]
-> ([(String, String)] -> [(String, String)]) -> [(String, String)]
forall a b. a -> (a -> b) -> b
& ((String
"DISPLAY", String
displayNum) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)
          [(String, String)]
-> ([(String, String)] -> [(String, String)]) -> [(String, String)]
forall a b. a -> (a -> b) -> b
& ((String
"XAUTHORITY", String
xvfbXauthority) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)
          [(String, String)]
-> ([(String, String)] -> [(String, String)]) -> [(String, String)]
forall a b. a -> (a -> b) -> b
& ((String, String) -> (String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> ((String, String) -> String)
-> (String, String)
-> (String, String)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String, String) -> String
forall a b. (a, b) -> a
fst)

  let videoPath :: String
videoPath = String
path String -> String -> String
<.> String
videoExtension

  let cmd :: [String]
cmd = [String
"-y"
            , String
"-nostdin"
            , String
"-f", String
"x11grab"
            , String
"-s", [i|#{width}x#{height}|]
            , String
"-i", [i|#{displayNum}.0+#{x},#{y}|]]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xcbgrabOptions
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
videoPath]
  (CreateProcess, String) -> m (CreateProcess, String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> [String] -> CreateProcess
proc String
ffmpeg [String]
cmd) { env = Just env }, String
videoPath)
#endif

#ifdef darwin_HOST_OS
  maybeScreenNumber <- liftIO getMacScreenNumber
  let videoPath = [i|#{path}.avi|]
  let cmd = case maybeScreenNumber of
        Just screenNumber -> ["-y"
                             , "-nostdin"
                             , "-f", "avfoundation"
                             , "-video-size", [i|#{width}x#{height}|]
                             , "-vf", [i|crop=#{width}:#{height}:#{x}:#{y}|]
                             , "-i", [i|#{screenNumber}|]]
                             ++ avfoundationOptions
                             ++ [videoPath]
        Nothing -> error [i|Not launching ffmpeg since OS X screen number couldn't be determined.|]
  return ((proc ffmpeg cmd) { env = Nothing }, videoPath)
#endif

#ifdef mingw32_HOST_OS
  let videoPath = [i|#{path}.mkv|]
  let cmd = ["-f", "gdigrab"
            , "-nostdin"
            , "-i", "desktop"
            , "-offset_x", [i|#{x}|]
            , "-offset_y", [i|#{y}|]
            , "-video-size", [i|#{width}x#{height}|]
            ]
            ++ gdigrabOptions
            ++ [videoPath]
  return ((proc ffmpeg cmd) { env = Nothing }, videoPath)
#endif