{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, FlexibleContexts, OverloadedStrings, NamedFieldPuns, ViewPatterns #-}
module Test.Sandwich.WebDriver.Internal.Video where
import Control.Monad.IO.Class
import Data.Maybe
import Data.String.Interpolate
import System.Environment
import System.Process
import Test.Sandwich.WebDriver.Internal.Types
#ifdef darwin_HOST_OS
import Safe
#endif
getVideoArgs :: src
-> (a, b, c, d)
-> VideoSettings
-> Maybe XvfbSession
-> m CreateProcess
getVideoArgs src
path (a
width, b
height, c
x, d
y) (VideoSettings {Bool
[String]
logToDisk :: VideoSettings -> Bool
hideMouseWhenRecording :: VideoSettings -> Bool
gdigrabOptions :: VideoSettings -> [String]
avfoundationOptions :: VideoSettings -> [String]
x11grabOptions :: VideoSettings -> [String]
logToDisk :: Bool
hideMouseWhenRecording :: Bool
gdigrabOptions :: [String]
avfoundationOptions :: [String]
x11grabOptions :: [String]
..}) Maybe XvfbSession
maybeXvfbSession = do
#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 (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)
lookupEnv String
"DISPLAY")
Just (XvfbSession {Int
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum :: Int
xvfbDisplayNum}) -> String -> m String
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
let videoPath :: String
videoPath = [i|#{path}.avi|]
let env' :: [(String, String)]
env' = [(String
"DISPLAY", String
displayNum)]
let env :: Maybe [(String, String)]
env = case Maybe XvfbSession
maybeXvfbSession of
Maybe XvfbSession
Nothing -> [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
env'
Just (XvfbSession {String
xvfbXauthority :: XvfbSession -> String
xvfbXauthority :: String
xvfbXauthority}) -> [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ((String
"XAUTHORITY", String
xvfbXauthority) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
env')
let cmd :: [String]
cmd = [String
"-draw_mouse", (if Bool
hideMouseWhenRecording then String
"0" else String
"1")
, 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]
x11grabOptions
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
videoPath]
CreateProcess -> m CreateProcess
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> [String] -> CreateProcess
proc String
"ffmpeg" [String]
cmd) { env :: Maybe [(String, String)]
env = Maybe [(String, String)]
env })
#endif
#ifdef darwin_HOST_OS
maybeScreenNumber <- liftIO getMacScreenNumber
let videoPath = [i|#{path}.avi|]
let cmd = case maybeScreenNumber of
Just screenNumber -> ["-y"
, "-nostdin"
, "-f", "avfoundation"
, "-i", [i|#{screenNumber}|]]
++ avfoundationOptions
++ [videoPath]
Nothing -> error [i|Not launching ffmpeg since OS X screen number couldn't be determined.|]
return ((proc "ffmpeg" cmds) { env = Nothing })
#endif
#ifdef mingw32_HOST_OS
let videoPath = [i|#{path}.mkv|]
let cmd = ["-f", "gdigrab"
, "-nostdin"
, "-draw_mouse", (if hideMouseWhenRecording then "0" else "1")
, "-i", "desktop"]
++ gdigrabOptions
++ [videoPath]
return ((proc "ffmpeg.exe" cmd) { env = Nothing })
#endif