Class.hs

module Test.Marionette.Class where

import Control.Monad.Error.Class (MonadError)
import Data.Aeson (FromJSON, Value)
import Data.Functor (void)
import Data.Functor.Identity (Identity (..))
import GHC.Stack (HasCallStack)
import Test.Marionette.Protocol (Command, Error)
import UnliftIO (MonadUnliftIO, mapConcurrently)
import Prelude

-- | Monads with the ability to send commands to a Marionette server and receive their results.
class (Functor m, MonadError Error m) => Marionette m where
    -- | Send a single command, decoding its result.
    sendCommand :: (HasCallStack, FromJSON a) => Command -> m a
    sendCommand = fmap runIdentity . sendCommands . Identity

    -- | Send multiple commands, decoding each result.
    -- The commands may be sent in parallel.
    sendCommands
        :: (HasCallStack, Traversable t, FromJSON a)
        => t Command
        -> m (t a)
    default sendCommands
        :: (HasCallStack, MonadUnliftIO m, Traversable t, FromJSON a)
        => t Command
        -> m (t a)
    sendCommands = mapConcurrently sendCommand

    {-# MINIMAL sendCommand | sendCommands #-}

-- | Send a single command, discarding its result.
sendCommand_ :: (HasCallStack, Marionette m) => Command -> m ()
sendCommand_ = void . sendCommand @_ @Value

-- | Send several commands, discarding their results.
-- The commands may be sent in parallel.
sendCommands_ :: (HasCallStack, Traversable t, Marionette m) => t Command -> m ()
sendCommands_ = void . sendCommands @_ @_ @Value