module Test.Sandwich.WebDriver.Internal.OnDemand where

import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Data.String.Interpolate
import Data.Text as T
import Test.Sandwich
import Test.Sandwich.WebDriver.Internal.Types
import UnliftIO.Async
import UnliftIO.Exception
import UnliftIO.MVar


getOnDemand :: forall m a. (
  MonadUnliftIO m, MonadLogger m
  ) => MVar (OnDemand a) -> m (Either Text a) -> m a
getOnDemand :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
MVar (OnDemand a) -> m (Either Text a) -> m a
getOnDemand MVar (OnDemand a)
onDemandVar m (Either Text a)
doObtain = do
  Either (Async a) a
result <- MVar (OnDemand a)
-> (OnDemand a -> m (OnDemand a, Either (Async a) a))
-> m (Either (Async a) a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (OnDemand a)
onDemandVar ((OnDemand a -> m (OnDemand a, Either (Async a) a))
 -> m (Either (Async a) a))
-> (OnDemand a -> m (OnDemand a, Either (Async a) a))
-> m (Either (Async a) a)
forall a b. (a -> b) -> a -> b
$ \case
    OnDemandErrored Text
msg -> String -> m (OnDemand a, Either (Async a) a)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure (Text -> String
T.unpack Text
msg)
    OnDemand a
OnDemandNotStarted -> do
      Async a
asy <- m a -> m (Async a)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m a -> m (Async a)) -> m a -> m (Async a)
forall a b. (a -> b) -> a -> b
$ do
        let handler :: SomeException -> m a
            handler :: SomeException -> m a
handler SomeException
e = do
              MVar (OnDemand a) -> (OnDemand a -> m (OnDemand a)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ MVar (OnDemand a)
onDemandVar (m (OnDemand a) -> OnDemand a -> m (OnDemand a)
forall a b. a -> b -> a
const (m (OnDemand a) -> OnDemand a -> m (OnDemand a))
-> m (OnDemand a) -> OnDemand a -> m (OnDemand a)
forall a b. (a -> b) -> a -> b
$ OnDemand a -> m (OnDemand a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OnDemand a -> m (OnDemand a)) -> OnDemand a -> m (OnDemand a)
forall a b. (a -> b) -> a -> b
$ Text -> OnDemand a
forall a. Text -> OnDemand a
OnDemandErrored [i|Got exception: #{e}|])
              SomeException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e

        (SomeException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle SomeException -> m a
handler (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ do
          m (Either Text a)
doObtain m (Either Text a) -> (Either Text a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left Text
err -> do
              MVar (OnDemand a) -> (OnDemand a -> m (OnDemand a)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ MVar (OnDemand a)
onDemandVar (m (OnDemand a) -> OnDemand a -> m (OnDemand a)
forall a b. a -> b -> a
const (m (OnDemand a) -> OnDemand a -> m (OnDemand a))
-> m (OnDemand a) -> OnDemand a -> m (OnDemand a)
forall a b. (a -> b) -> a -> b
$ OnDemand a -> m (OnDemand a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OnDemand a -> m (OnDemand a)) -> OnDemand a -> m (OnDemand a)
forall a b. (a -> b) -> a -> b
$ Text -> OnDemand a
forall a. Text -> OnDemand a
OnDemandErrored Text
err)
              String -> m a
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Failed to obtain: #{err}|]

            Right a
x -> do
              MVar (OnDemand a) -> (OnDemand a -> m (OnDemand a)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ MVar (OnDemand a)
onDemandVar (m (OnDemand a) -> OnDemand a -> m (OnDemand a)
forall a b. a -> b -> a
const (m (OnDemand a) -> OnDemand a -> m (OnDemand a))
-> m (OnDemand a) -> OnDemand a -> m (OnDemand a)
forall a b. (a -> b) -> a -> b
$ OnDemand a -> m (OnDemand a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OnDemand a -> m (OnDemand a)) -> OnDemand a -> m (OnDemand a)
forall a b. (a -> b) -> a -> b
$ a -> OnDemand a
forall a. a -> OnDemand a
OnDemandReady a
x)
              a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

      (OnDemand a, Either (Async a) a)
-> m (OnDemand a, Either (Async a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Async a -> OnDemand a
forall a. Async a -> OnDemand a
OnDemandInProgress Async a
asy, Async a -> Either (Async a) a
forall a b. a -> Either a b
Left Async a
asy)

    od :: OnDemand a
od@(OnDemandInProgress Async a
asy) -> (OnDemand a, Either (Async a) a)
-> m (OnDemand a, Either (Async a) a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnDemand a
od, Async a -> Either (Async a) a
forall a b. a -> Either a b
Left Async a
asy)
    od :: OnDemand a
od@(OnDemandReady a
x) -> (OnDemand a, Either (Async a) a)
-> m (OnDemand a, Either (Async a) a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnDemand a
od, a -> Either (Async a) a
forall a b. b -> Either a b
Right a
x)

  case Either (Async a) a
result of
    Right a
x -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Left Async a
asy -> Async a -> m a
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait Async a
asy