{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-missing-role-annotations #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- |
-- Module : Effectful.Marionette
-- Copyright : (c) 2026 Institute for Digital Autonomy
-- License : EUPL-1.2
-- Maintainer : IDA
--
-- <https://firefox-source-docs.mozilla.org/testing/marionette/ Marionette> is
-- Firefox's built-in remote-control protocol. It plays the same role as a
-- <https://www.w3.org/TR/webdriver/ WebDriver> server, letting a test suite
-- drive a real Firefox instance to navigate, find and interact with
-- elements, execute scripts, and so on. In addition to WebDriver functionality,
-- Marionette can also address Firefox's own chrome (its menus and toolbars)
-- rather than just the content of a web page, and speaks its own lightweight
-- length-prefixed JSON protocol directly over a TCP socket instead of
-- HTTP.
--
-- This module lifts every command from the
-- <https://hackage.haskell.org/package/marionette marionette> library into
-- the 'Eff' monad as a 'Marionette' effect. Run 'runMarionette' to open the
-- connection and discharge that effect for the duration of your action.
--
-- = How to use Marionette
--
-- == Starting Firefox and a session
--
-- Launch Firefox with the @--marionette@ flag so that it listens for
-- connections on port 2828.
--
-- Use 'runMarionette' to connect to it and run a client program.
-- Start a new session with 'newSession', and quit the session with 'quit':
--
-- > import Effectful
-- > import Effectful.Marionette
-- > import Effectful.Process.Typed
-- > import System.Process.Typed (proc)
-- >
-- > main :: IO ()
-- > main =
-- > runEff . runTypedProcess $
-- > withProcessTerm_ (proc "firefox" ["--marionette", "--headless"]) \_process ->
-- > runMarionette $ do
-- > newSession
-- > -- More Marionette actions go here
-- > quit
--
-- Most Marionette actions need to be performed in a session.
--
-- == Finding and interacting with elements
--
-- Find elements by calling 'findElement' with a 'Selector',
-- then pass the resulting 'Element' to other commands:
--
-- > submitForm :: (HasCallStack, Marionette :> es) => Eff es ()
-- > submitForm = do
-- > input <- findElement (ById "text-input")
-- > elementSendKeys input "hello, world"
-- > submit <- findElement (ByCSS "button[type=submit]")
-- > elementClick submit
--
-- == Error handling
--
-- Catch command failures using @Effectful.Exception@,
-- for example to retry a command against a fallback element:
--
-- > import Effectful.Exception (catchError)
-- >
-- > clickFirstAvailable :: (HasCallStack, Marionette :> es) => Eff es ()
-- > clickFirstAvailable =
-- > (elementClick =<< findElement (ById "primary-button"))
-- > `catchError` \_ -> elementClick =<< findElement (ById "fallback-button")
module Effectful.Marionette
( -- * Effect
Marionette
, runMarionette
-- * Re-exports from @Marionette@
, module Test.Marionette
)
where
import Control.Monad.Error.Class (MonadError (..))
import Effectful
( Dispatch (Static)
, DispatchOf
, Eff
, Effect
, IOE
, Limit (..)
, Persistence (Ephemeral)
, UnliftStrategy (ConcUnlift)
, withEffToIO
, (:>)
)
import Effectful.Dispatch.Static
( SideEffects (WithSideEffects)
, StaticRep
, evalStaticRep
, getStaticRep
, unsafeEff_
)
import Effectful.Exception (catch, throwIO)
import Test.Marionette hiding (Marionette)
import Test.Marionette qualified as Marionette
import Test.Marionette.Class qualified as Marionette
import UnliftIO (withRunInIO)
import Prelude
data Marionette :: Effect
type instance DispatchOf Marionette = 'Static 'WithSideEffects
newtype instance StaticRep Marionette = Marionette (forall a. MarionetteT IO a -> IO a)
instance {-# OVERLAPPING #-} MonadError Marionette.Error (Eff es) where
throwError = throwIO
catchError = catch
instance (Marionette :> es) => Marionette.Marionette (Eff es) where
sendCommands commands = do
Marionette unlift <- getStaticRep
unsafeEff_ . unlift $ Marionette.sendCommands commands
-- | Connect to a Marionette server listening on @localhost:2828@ (started
-- by launching Firefox with the @--marionette@ flag), and run the given
-- action against it.
runMarionette
:: (IOE :> es)
=> Eff (Marionette ': es) a
-> Eff es a
runMarionette action =
withEffToIO (ConcUnlift Ephemeral Unlimited) \unlift -> runMarionetteT $
withRunInIO \runInIO -> unlift . evalStaticRep (Marionette runInIO) $ action