module BiDi.DemoUtils where

import BiDi.Actions (BiDiActions (..), mkActions)
import BiDi.BiDiUrl (BiDiUrl, getBiDiUrl)
import BiDi.Runner (withBiDi, withBidiFailTest)
import BiDi.Socket (SocketActions)
import Config (Config (..))
import ConfigLoader (loadConfig)
import Const (Timeout (..), milliseconds, seconds)
import Control.Exception (Exception, SomeException, catch, throwIO, try)
import Data.Function ((&))
import Data.Text (Text, isInfixOf, unpack)
import Data.Text qualified as T
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
import Data.Word (Word64)
import HTTP.Actions qualified as HTTPA
import HTTP.DemoUtils (withSession)
import HTTP.Runner (mkRunner)
import IOUtils (DemoActions (..), Logger, logNothingLogger, mkDemoActions)
import Logger (withChannelFileLogger)
import Network.HTTP.Req (http)
import RuntimeConst (httpCapabilities, httpFullCapabilities)
import Utils (txt)
import WebDriverPreCore.BiDi.Protocol
  ( BrowsingContext (..),
    Close (..),
    ContextTarget (..),
    Create (..),
    CreateType (..),
    Evaluate (..),
    EvaluateResult (..),
    GetTree (..),
    GetTreeResult (..),
    Info (..),
    PrimitiveProtocolValue (..),
    RemoteValue (..),
    StringValue (..),
    Target (..),
  )
import WebDriverPreCore.HTTP.Protocol (FullCapabilities (..))
import WebDriverPreCore.HTTP.Protocol qualified as Caps (Capabilities (..))
import Prelude hiding (log, putStrLn)

data BiDiDemo = MkBiDiDemo
  { name :: Text,
    action :: DemoActions -> BiDiActions -> IO ()
  }

demo :: Text -> (DemoActions -> BiDiActions -> IO ()) -> BiDiDemo
demo name action = MkBiDiDemo {name, action}

-- -- Bidi capabilities request is the same as regular HTTP capabilities,
-- -- but with the `webSocketUrl` field set to `True`
httpBidiCapabilities :: Config -> FullCapabilities
httpBidiCapabilities cfg =
  (httpFullCapabilities cfg)
    { alwaysMatch =
        Just $ (httpCapabilities cfg) {Caps.webSocketUrl = Just True}
    }

type Runner = DemoActions -> BiDiUrl -> (DemoActions -> SocketActions -> IO ()) -> IO ()

runDemo' :: Config -> BiDiDemo -> IO ()
runDemo' = runDemo'' withBiDi

runDemo'' :: Runner -> Config -> BiDiDemo -> IO ()
runDemo''
  bidiRunner
  cfg@MkConfig
    { httpUrl,
      httpPort,
      logging,
      pauseMS
    }
  demo' = do
    if logging
      then
        withChannelFileLogger runWithLogger
      else
        runWithLogger logNothingLogger
    where
      httpCaps = httpBidiCapabilities cfg
      runWithLogger :: Logger -> IO ()
      runWithLogger logger =
        let demoActions = mkDemoActions logger $ fromIntegral pauseMS * milliseconds
            httpRunner = mkRunner (http httpUrl) (fromIntegral httpPort) demoActions
            httpActions = HTTPA.mkActions httpRunner
         in withSession httpCaps httpActions $ \ses -> do
              bidiUrl <- getBiDiUrl ses & either (fail . unpack) pure
              bidiRunner demoActions bidiUrl $ \_ socketActions -> do
                let bidiActions = mkActions socketActions
                demoActions.logTxt $ "Executing: " <> demo'.name
                demo'.action demoActions bidiActions

runDemo :: BiDiDemo -> IO ()
runDemo dmo = loadConfig >>= flip runDemo' dmo

runDemoFail :: Word64 -> Word64 -> Word64 -> BiDiDemo -> IO ()
runDemoFail failSendCount failGetCount failEventCount dmo = loadConfig >>= \c -> runDemoFail' c failSendCount failGetCount failEventCount dmo

runDemoFail' :: Config -> Word64 -> Word64 -> Word64 -> BiDiDemo -> IO ()
runDemoFail' config failSendCount failGetCount failEventCount dmo = runDemo'' (withBidiFailTest failSendCount failGetCount failEventCount) config dmo

newWindowContext :: DemoActions -> BiDiActions -> IO BrowsingContext
newWindowContext MkDemoActions {..} MkBiDiActions {..} = do
  logTxt "New browsing context - Window"
  bcWin <- browsingContextCreate bcParams {createType = Window}
  logShow "Browsing context - Window" bcWin
  pause
  pure bcWin
  where
    bcParams =
      MkCreate
        { createType = Tab,
          background = False,
          referenceContext = Nothing,
          userContext = Nothing
        }

closeContext :: DemoActions -> BiDiActions -> BrowsingContext -> IO ()
closeContext MkDemoActions {pause, logTxt, logShow} MkBiDiActions {..} bc = do
  logTxt "Close browsing context"
  co <- browsingContextClose $ MkClose {context = bc, promptUnload = Nothing}
  logShow "Close result" co
  pause

rootContext :: DemoActions -> BiDiActions -> IO BrowsingContext
rootContext MkDemoActions {..} MkBiDiActions {..} = do
  logTxt "Get root browsing context"
  tree <- browsingContextGetTree $ MkGetTree Nothing Nothing
  logShow "Browsing context tree" tree
  case tree of
    MkGetTreeResult (info : _) -> pure $ info.context
    _ -> error "No browsing contexts found"

-- | Custom exception for text validation failures
data TextValidationError = MkTextValidationError
  { message :: Text,
    expectedText :: Text,
    actualText :: Text
  }
  deriving (Show)

instance Exception TextValidationError

-- | Check if expected text is present in DOM with timeout and retry, throw error if not found
chkDomContains' :: Timeout -> Timeout -> DemoActions -> BiDiActions -> BrowsingContext -> Text -> IO ()
chkDomContains' timeout pause' MkDemoActions {..} MkBiDiActions {..} bc expectedText = do
  startTime <- getPOSIXTime
  logTxt $ "Checking DOM contains: " <> expectedText <> " (timeout: " <> txt timeout <> "ms, pause: " <> txt pause' <> "ms)"
  checkLoop $ startTime + (fromIntegral timeout.microseconds / 1000000)
  where
    checkLoop :: POSIXTime -> IO ()
    checkLoop endTime = do
      currentTime <- getPOSIXTime
      if currentTime > endTime
        then do
          throwIO $
            MkTextValidationError
              { message = "✗ Timeout reached! Expected text not found after " <> txt timeout <> "ms",
                expectedText,
                actualText = ""
              }
        else do
          result <-
            (validateDomText >> pure ()) `catch` \(_ :: TextValidationError) -> do
              pauseAtLeast pause'
              checkLoop endTime
          pure result

    validateDomText :: IO ()
    validateDomText = do
      -- Get the full DOM text content
      domResult <-
        scriptEvaluate $
          MkEvaluate
            { expression = "document.body ? document.body.innerText || document.body.textContent || '' : ''",
              target = ContextTarget $ MkContextTarget {context = bc, sandbox = Nothing},
              awaitPromise = False,
              resultOwnership = Nothing,
              serializationOptions = Nothing
            }

      case domResult of
        EvaluateResultSuccess {result = PrimitiveValue (StringValue (MkStringValue actualText))} -> do
          if expectedText `isInfixOf` actualText
            then logTxt $ "✓ Found expected text: " <> expectedText
            else do
              throwIO $
                MkTextValidationError
                  { message = "✗ Expected text not in DOM",
                    expectedText,
                    actualText
                  }
        EvaluateResultSuccess {result = otherResult} -> do
          throwIO $
            MkTextValidationError
              { message = "Unexpected result type: " <> txt otherResult,
                expectedText,
                actualText = "Non-string result"
              }
        EvaluateResultException {exceptionDetails} -> do
          throwIO $
            MkTextValidationError
              { message = "✗ Script evaluation failed",
                expectedText,
                actualText = txt exceptionDetails
              }

-- | Check if expected text is present in DOM with default timeout and retry settings
chkDomContains :: DemoActions -> BiDiActions -> BrowsingContext -> Text -> IO ()
chkDomContains = chkDomContains' (10 * seconds) (MkTimeout 100)

data FailTest
  = Predicate (Text -> Bool)
  | Fragment Text

toLambda :: FailTest -> (Text -> Bool)
toLambda = \case
  Predicate f -> f
  Fragment t -> \errText -> t `T.isInfixOf` errText

expectErrorText :: Text -> Text -> IO () -> IO ()
expectErrorText testName expectedFragment =
  expectError testName (Fragment expectedFragment)

toText :: FailTest -> Text
toText (Fragment t) = t
toText (Predicate _) = "<custom lambda>"

-- | General function to test that an IO action throws an exception containing expected text
expectError :: Text -> FailTest -> IO () -> IO ()
expectError testName failTest action = do
  result <- try action
  case result of
    Left (e :: SomeException) -> do
      let errText = txt $ show e
      if toLambda failTest errText
        then pure ()
        else
          fail . unpack $
            testName
              <> ": Error did not contain expected fragment."
              <> "\n"
              <> " Expected Fragment was: "
              <> "\n"
              <> toText failTest 
              <> "\n"
              <> "Actual Error was:"
              <> "\n"
              <> errText
    Right _ ->
      fail $ unpack $ testName <> ": Expected error, but action completed successfully."