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 = (Identity a -> a) -> m (Identity a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity a -> a
forall a. Identity a -> a
runIdentity (m (Identity a) -> m a)
-> (Command -> m (Identity a)) -> Command -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Command -> m (Identity a)
forall (m :: * -> *) (t :: * -> *) a.
(Marionette m, HasCallStack, Traversable t, FromJSON a) =>
t Command -> m (t a)
forall (t :: * -> *) a.
(HasCallStack, Traversable t, FromJSON a) =>
t Command -> m (t a)
sendCommands (Identity Command -> m (Identity a))
-> (Command -> Identity Command) -> Command -> m (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Identity Command
forall a. a -> Identity a
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 = (Command -> m a) -> t Command -> m (t a)
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently Command -> m a
forall a. (HasCallStack, FromJSON a) => Command -> m a
forall (m :: * -> *) a.
(Marionette m, HasCallStack, FromJSON a) =>
Command -> m a
sendCommand

    {-# MINIMAL sendCommand | sendCommands #-}

-- | Send a single command, discarding its result.
sendCommand_ :: (HasCallStack, Marionette m) => Command -> m ()
sendCommand_ :: forall (m :: * -> *).
(HasCallStack, Marionette m) =>
Command -> m ()
sendCommand_ = m Value -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Value -> m ()) -> (Command -> m Value) -> Command -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(Marionette m, HasCallStack, FromJSON a) =>
Command -> m a
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_ :: forall (t :: * -> *) (m :: * -> *).
(HasCallStack, Traversable t, Marionette m) =>
t Command -> m ()
sendCommands_ = m (t Value) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (t Value) -> m ())
-> (t Command -> m (t Value)) -> t Command -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (t :: * -> *) a.
(Marionette m, HasCallStack, Traversable t, FromJSON a) =>
t Command -> m (t a)
sendCommands @_ @_ @Value