FallbackDemo.hs

module HTTP.FallbackDemo where

import Data.Aeson as A (Value (..))
import Data.Aeson qualified as A
import Data.Aeson.KeyMap qualified as A
import Data.Function ((&))
import Data.Text (Text)
import HTTP.DemoUtils (HttpDemo, runDemo, sessionDemo)
import HTTP.Actions (HttpActions (..))
import IOUtils (DemoActions (..))
import TestData (checkboxesUrl, textAreaUrl)
import WebDriverPreCore.HTTP.API qualified as A
import WebDriverPreCore.HTTP.Protocol
  ( Command (..),
    ElementId (..),
    Session (..),
    Timeouts (..),
    coerceCommand,
    extendPost,
    extendPostLoosen,
    loosenCommand,
    voidCommand,
  )
import Utils (UrlPath (..))
import Prelude hiding (log)

-- >>> runDemo demoFallbackActions
demoFallbackActions :: HttpDemo
demoFallbackActions =
  sessionDemo "fallback actions demo - manually construct commands" action
  where
    action :: Session -> DemoActions -> HttpActions -> IO ()
    action sesId MkDemoActions {..} MkHttpActions {runCommand} = do
      -- Navigate to checkboxes page using runCommand and log the response
      url <- checkboxesUrl
      let navigateCmd =
            Post
              { description = "Navigate To (using fallback)",
                path = sessionUri1 sesId "url",
                body = A.fromList ["url" A..= url]
              }

      logTxt "Navigate using runCommand"
      -- as we haven't put a type signature on navigateCmd, we need to use @() to indicate we expect no return value
      navigateResult <- runCommand @() navigateCmd
      logShow "Navigate response" navigateResult
      pause

      -- Find the checkbox using Value command with runCommand
      let findElementCmd =
            Post
              { description = "Find Element (using fallback Value)",
                path = sessionUri1 sesId "element",
                body = A.fromList ["using" A..= ("css selector" :: String), "value" A..= ("#checkbox1" :: String)]
              }

      logTxt "Find checkbox element using Value command and runCommand"
      -- as we haven't put a type signature on findElementCmd, we need to use @Value to indicate we expect a Value return type
      val <- runCommand @Value findElementCmd
      logShow "Element search Result" val
      logShow "Full response" val
      pause

      -- Extract element ID from the Value result
      let checkboxId = case val of
            A.Object obj ->
              A.lookup "element-6066-11e4-a52e-4f735466cecf" obj
                & maybe
                  (error "Failed to extract element ID from response")
                  ( \case
                      A.String eid -> MkElement eid
                      _ -> error "Expected string for element ID"
                  )
            _ -> error "Expected object in response"

      logShow "Extracted element ID" checkboxId
      pause

newtype MyURL = MkMyURL {getMyURL :: Text}
  deriving (Show, Eq)
  deriving newtype (A.FromJSON)

-- >>> runDemo demoFallbackCoercions
demoFallbackCoercions :: HttpDemo
demoFallbackCoercions =
  sessionDemo "fallback coerce commands" action
  where
    action :: Session -> DemoActions -> HttpActions -> IO ()
    action sesId MkDemoActions {..} MkHttpActions {runCommand} = do
      -- Navigate to another page using typed Navigate command and getResponse
      logTxt "Navigate to another page using typed command and getResponse (navigateTo returns Command ())"
      url2 <- textAreaUrl
      runCommand $ A.navigateTo sesId url2
      pause

      logTxt "Return a different type with compatible JSON (runCommand will return MyURL )"
      myUrl <- runCommand . coerceCommand @_ @MyURL $ A.getCurrentUrl sesId
      logShow "Current url - coerced" myUrl
      pause

      logTxt "Return Value rather than url"
      url' <- runCommand . loosenCommand $ A.getCurrentUrl sesId
      logShow "Current url - as Value" url'
      pause

      logTxt "Return void rather than url"
      urlVoid <- runCommand . voidCommand $ A.getCurrentUrl sesId
      logShow "Current url - voided" urlVoid
      pause

-- >>> runDemo demoExtendPost
demoExtendPost :: HttpDemo
demoExtendPost =
  sessionDemo "fallback extend Post commands demo" action
  where
    action :: Session -> DemoActions -> HttpActions -> IO ()
    action sesId MkDemoActions {..} MkHttpActions {runCommand'} = do
      cbxsUrl <- checkboxesUrl
      runCommand' $ A.navigateTo sesId cbxsUrl
      
      -- Step 1: extendPost with a Post command
      let timeoutsCmd = A.setTimeouts sesId (MkTimeouts (Just 1000) Nothing Nothing)
          extended1 = A.fromList ["script" A..= (2000 :: Int)]
          extendedCmd1 = extendPost timeoutsCmd extended1
      logTxt "Extended Post Command" 
      logShowM "Extended Post Result" $ runCommand' extendedCmd1
      
      -- Step 2: extendPostLoosen with a Post command  
      let extended2 = A.fromList ["pageLoad" A..= (3000 :: Int)]
          extendedCmd2 = extendPostLoosen timeoutsCmd extended2
      logTxt "Extended Post (loosened) Command" 
      logShowM "Extended Post (loosened) Result" $ runCommand' extendedCmd2
      
      -- Step 3: extendPost with a PostEmpty command
      let backCmd = A.back sesId
          extended3 = A.fromList ["ignored" A..= String "test"]
          extendedCmd3 = extendPost backCmd extended3
      logTxt "Extended PostEmpty Command" 
      logShowM "Extended PostEmpty Result" $ runCommand' extendedCmd3
      
      -- Step 4: extendPostLoosen with a PostEmpty command
      let refreshCmd = A.refresh sesId
          extended4 = A.fromList ["alsoIgnored" A..= String "demo"]
          extendedCmd4 = extendPostLoosen refreshCmd extended4
      logTxt "Extended PostEmpty (loosened) Command" 
      logShowM "Extended PostEmpty (loosened) Result" $ runCommand' extendedCmd4
      
      pause

-- Helper functions (copied from API.hs since they're not exported)

sessionUri1 :: Session -> Text -> UrlPath
sessionUri1 s sp = MkUrlPath ["session", s.id, sp]

elementUri1 :: Session -> ElementId -> Text -> UrlPath
elementUri1 s er ep = MkUrlPath ["session", s.id, "element", er.id, ep]

_stopDemoUnusedWarning :: HttpDemo -> IO ()
_stopDemoUnusedWarning = runDemo