{-# LANGUAGE CPP #-} 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 getMacScreenNumber :: IO (Maybe Int) getMacScreenNumber = undefined #endif getVideoArgs :: p -> (a, b, c, d) -> VideoSettings -> Maybe XvfbSession -> m CreateProcess getVideoArgs p 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 -> forall a. a -> Maybe a -> a fromMaybe String "" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ String -> IO (Maybe String) lookupEnv String "DISPLAY") Just (XvfbSession {Int xvfbDisplayNum :: XvfbSession -> Int xvfbDisplayNum :: Int xvfbDisplayNum}) -> forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ String ":" forall a. Semigroup a => a -> a -> a <> 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 -> forall a. a -> Maybe a Just [(String, String)] env' Just (XvfbSession {String xvfbXauthority :: XvfbSession -> String xvfbXauthority :: String xvfbXauthority}) -> forall a. a -> Maybe a Just ((String "XAUTHORITY", String xvfbXauthority) 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}|]] forall a. [a] -> [a] -> [a] ++ [String] x11grabOptions forall a. [a] -> [a] -> [a] ++ [String videoPath] 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" cmd) { 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