{-# OPTIONS_HADDOCK hide #-}

module WebDriverPreCore.HTTP.Command
  ( Command (..),
    mkPost,
    mkPost',
    voidCommand,
    loosenCommand,
    coerceCommand,
    extendPost,
    extendPostLoosen,
  )
where

import Data.Aeson as A
  ( Object,
    ToJSON (..), Value,
  )
import Data.Text (Text)
import AesonUtils (objectOrThrow)
import Utils (UrlPath (..))
import Prelude hiding (id, lookup)

-- |
--  The 'Command' type is a specification for a WebDriver Http command.
--  Every endpoint function in this module returns a 'Command' object which defines the HTTP method, URL path, and request body (if applicable) for the command.
--  The phantom type parameter 'r' represents the expected response type for the command. In practice, this 'r' type will always have a 'FromJSON' instance which can be used to parse the result from the response body.
data Command r
  = Get
      { forall {k} (r :: k). Command r -> Text
description :: Text,
        forall {k} (r :: k). Command r -> UrlPath
path :: UrlPath
      }
  | Post
      { description :: Text,
        path :: UrlPath,
        forall {k} (r :: k). Command r -> Object
body :: Object
      }
  | PostEmpty
      { description :: Text,
        path :: UrlPath
      }
  | Delete
      { description :: Text,
        path :: UrlPath
      }
  deriving (Int -> Command r -> ShowS
[Command r] -> ShowS
Command r -> String
(Int -> Command r -> ShowS)
-> (Command r -> String)
-> ([Command r] -> ShowS)
-> Show (Command r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (r :: k). Int -> Command r -> ShowS
forall k (r :: k). [Command r] -> ShowS
forall k (r :: k). Command r -> String
$cshowsPrec :: forall k (r :: k). Int -> Command r -> ShowS
showsPrec :: Int -> Command r -> ShowS
$cshow :: forall k (r :: k). Command r -> String
show :: Command r -> String
$cshowList :: forall k (r :: k). [Command r] -> ShowS
showList :: [Command r] -> ShowS
Show, Command r -> Command r -> Bool
(Command r -> Command r -> Bool)
-> (Command r -> Command r -> Bool) -> Eq (Command r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (r :: k). Command r -> Command r -> Bool
$c== :: forall k (r :: k). Command r -> Command r -> Bool
== :: Command r -> Command r -> Bool
$c/= :: forall k (r :: k). Command r -> Command r -> Bool
/= :: Command r -> Command r -> Bool
Eq)


-- Constructors

-- | Creates a 'Post' command with the given description, path, and body.
--
-- The body parameter must be an instance of 'ToJSON' and encode to a JSON 'Object' type.
-- This function is partially applied in "WebDriverPreCore.HTTP.API" to generate specific named command functions.
--
-- If the body cannot be converted to a JSON 'Object', an error is thrown with the description included in the error message.
mkPost :: forall a r. (ToJSON a) => Text -> UrlPath -> a -> Command r
mkPost :: forall {k} a (r :: k).
ToJSON a =>
Text -> UrlPath -> a -> Command r
mkPost Text
description UrlPath
path = Text -> UrlPath -> (a -> Object) -> a -> Command r
forall {k} a (r :: k).
Text -> UrlPath -> (a -> Object) -> a -> Command r
mkPost' Text
description UrlPath
path (Text -> a -> Object
forall a. ToJSON a => Text -> a -> Object
objectOrThrow (Text
"mkPost - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
description))

-- | Creates a 'Post' command with the given description, path, and a custom parser function.
--
-- This is a more flexible version of 'mkPost' that allows you to provide a custom function to convert
-- the input parameter to a JSON 'Object'. This is useful when you need more control over the serialization process.
mkPost' :: forall a r. Text -> UrlPath -> (a -> Object) -> a -> Command r
mkPost' :: forall {k} a (r :: k).
Text -> UrlPath -> (a -> Object) -> a -> Command r
mkPost' Text
description UrlPath
path a -> Object
parser = Text -> UrlPath -> Object -> Command r
forall {k} (r :: k). Text -> UrlPath -> Object -> Command r
Post Text
description UrlPath
path (Object -> Command r) -> (a -> Object) -> a -> Command r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Object
parser

-- Fallback Functions

-- | Changes the expected response type of a 'Command' to a different type.
--
-- This function preserves the HTTP method, path, and request body while only changing the phantom type parameter.
-- It can be used to adapt a command when you need a different response type than what the command originally specified.
coerceCommand  :: forall r r'. Command r -> Command r'
coerceCommand :: forall {k} {k} (r :: k) (r' :: k). Command r -> Command r'
coerceCommand = \case
  Get {Text
description :: forall {k} (r :: k). Command r -> Text
description :: Text
description, UrlPath
path :: forall {k} (r :: k). Command r -> UrlPath
path :: UrlPath
path} -> Get {Text
description :: Text
description :: Text
description, UrlPath
path :: UrlPath
path :: UrlPath
path}
  Post {Text
description :: forall {k} (r :: k). Command r -> Text
description :: Text
description, UrlPath
path :: forall {k} (r :: k). Command r -> UrlPath
path :: UrlPath
path, Object
body :: forall {k} (r :: k). Command r -> Object
body :: Object
body} -> Post {Text
description :: Text
description :: Text
description, UrlPath
path :: UrlPath
path :: UrlPath
path, Object
body :: Object
body :: Object
body}
  PostEmpty {Text
description :: forall {k} (r :: k). Command r -> Text
description :: Text
description, UrlPath
path :: forall {k} (r :: k). Command r -> UrlPath
path :: UrlPath
path} -> PostEmpty {Text
description :: Text
description :: Text
description, UrlPath
path :: UrlPath
path :: UrlPath
path}
  Delete {Text
description :: forall {k} (r :: k). Command r -> Text
description :: Text
description, UrlPath
path :: forall {k} (r :: k). Command r -> UrlPath
path :: UrlPath
path} -> Delete {Text
description :: Text
description :: Text
description, UrlPath
path :: UrlPath
path :: UrlPath
path}

-- | Changes the expected response type of a 'Command' to a generic JSON 'Value'.
--
-- This is a specialization of 'coerceCommand' that loosens the type constraint,
-- allowing you to handle responses in a more flexible way when the exact response structure is not known or not needed.
loosenCommand :: forall r. Command r -> Command Value
loosenCommand :: forall {k} (r :: k). Command r -> Command Value
loosenCommand = Command r -> Command Value
forall {k} {k} (r :: k) (r' :: k). Command r -> Command r'
coerceCommand

-- | Changes the expected response type of a 'Command' to @()@, indicating that the response should be ignored.
--
-- This is useful for commands where you only care about the side effects and not the response value.
voidCommand :: Command a -> Command ()
voidCommand :: forall {k} (a :: k). Command a -> Command ()
voidCommand = Command a -> Command ()
forall {k} {k} (r :: k) (r' :: k). Command r -> Command r'
coerceCommand

-- | Extends the request body of a 'Post' or 'PostEmpty' command with additional fields from a JSON 'Object',
-- changing the expected response type to a generic JSON 'Value'.
--
-- For 'Post' commands, the additional fields are merged with the existing body.
-- For 'PostEmpty' commands, the additional fields become the new body.
-- Attempting to use this with 'Get' or 'Delete' commands will result in a runtime error.
extendPostLoosen :: forall r. Command r -> Object -> Command Value
extendPostLoosen :: forall {k} (r :: k). Command r -> Object -> Command Value
extendPostLoosen = Command r -> Object -> Command Value
forall {k} {k} (r :: k) (r2 :: k).
Command r -> Object -> Command r2
extendCoercePost

-- | Extends the request body of a 'Post' or 'PostEmpty' command with additional fields from a JSON 'Object',
-- preserving the expected response type.
--
-- For 'Post' commands, the additional fields are merged with the existing body.
-- For 'PostEmpty' commands, the additional fields become the new body.
-- Attempting to use this with 'Get' or 'Delete' commands will result in a runtime error.
extendPost :: forall r. Command r -> Object -> Command r
extendPost :: forall {k} (r :: k). Command r -> Object -> Command r
extendPost = Command r -> Object -> Command r
forall {k} {k} (r :: k) (r2 :: k).
Command r -> Object -> Command r2
extendCoercePost

-- | Extends the request body of a 'Post' or 'PostEmpty' command with additional fields from a JSON 'Object',
-- changing the expected response type to a different type.
--
-- This is the underlying implementation used by both 'extendPost' and 'extendPostLoosen'.
-- For 'Post' commands, the additional fields are merged with the existing body.
-- For 'PostEmpty' commands, the additional fields become the new body.
-- Attempting to use this with 'Get' or 'Delete' commands will result in a runtime error.
extendCoercePost :: forall r r2. Command r -> Object -> Command r2
extendCoercePost :: forall {k} {k} (r :: k) (r2 :: k).
Command r -> Object -> Command r2
extendCoercePost Command r
cmd Object
extended =
  case Command r
cmd of
    Post {Text
description :: forall {k} (r :: k). Command r -> Text
description :: Text
description, UrlPath
path :: forall {k} (r :: k). Command r -> UrlPath
path :: UrlPath
path, Object
body :: forall {k} (r :: k). Command r -> Object
body :: Object
body} -> Post {Text
description :: Text
description :: Text
description, UrlPath
path :: UrlPath
path :: UrlPath
path, body :: Object
body = Object
body Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
extended}
    PostEmpty {Text
description :: forall {k} (r :: k). Command r -> Text
description :: Text
description, UrlPath
path :: forall {k} (r :: k). Command r -> UrlPath
path :: UrlPath
path} -> Post {description :: Text
description = Text
description, path :: UrlPath
path = UrlPath
path, body :: Object
body = Object
extended}
    get :: Command r
get@Get {} -> 
        String -> Command r2
forall a. HasCallStack => String -> a
error (String -> Command r2) -> String -> Command r2
forall a b. (a -> b) -> a -> b
$ String
"extendPost called with Get Command (extendPost can only be called with Post or PostEmpty commands): " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Command r -> String
forall a. Show a => a -> String
show Command r
get
    del :: Command r
del@Delete {} -> 
        String -> Command r2
forall a. HasCallStack => String -> a
error (String -> Command r2) -> String -> Command r2
forall a b. (a -> b) -> a -> b
$ String
"extendPost called with Delete Command (extendPost can only be called with Post or PostEmpty commands): " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Command r -> String
forall a. Show a => a -> String
show Command r
del