{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}

module Test.WebDriver.Class (
  -- * WebDriver class
  WebDriver(..), Method, methodDelete, methodGet, methodPost,
  ) where
import Test.WebDriver.Session

import Data.Aeson
import Data.Text (Text)
import Network.HTTP.Types.Method (methodDelete, methodGet, methodPost, Method)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.RWS.Lazy as LRWS
import Control.Monad.Trans.RWS.Strict as SRWS
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Lazy as LS
import Control.Monad.Trans.State.Strict as SS
import Control.Monad.Trans.Writer.Lazy as LW
import Control.Monad.Trans.Writer.Strict as SW
import Data.CallStack

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid) -- for some reason "import Prelude" trick doesn't work with "import Data.Monoid"
#endif


-- |A class for monads that can handle wire protocol requests. This is the
-- operation underlying all of the high-level commands exported in
-- "Test.WebDriver.Commands". For more information on the wire protocol see
-- <https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol>
class (WDSessionStateControl wd) => WebDriver wd where
  doCommand :: (HasCallStack, ToJSON a, FromJSON b) =>
                   Method      -- ^HTTP request method
                -> Text        -- ^URL of request
                -> a           -- ^JSON parameters passed in the body
                               -- of the request. Note that, as a special case,
                               -- anything that converts to Data.Aeson.Null will
                               -- result in an empty request body.
                -> wd b        -- ^The JSON result of the HTTP request.

instance WebDriver wd => WebDriver (SS.StateT s wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> StateT s wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance WebDriver wd => WebDriver (LS.StateT s wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> StateT s wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance WebDriver wd => WebDriver (MaybeT wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> MaybeT wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance WebDriver wd => WebDriver (IdentityT wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> IdentityT wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance (Monoid w, WebDriver wd) => WebDriver (LW.WriterT w wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> WriterT w wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance (Monoid w, WebDriver wd) => WebDriver (SW.WriterT w wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> WriterT w wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance WebDriver wd => WebDriver (ReaderT r wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> ReaderT r wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance WebDriver wd => WebDriver (ExceptT e wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> ExceptT e wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance (Monoid w, WebDriver wd) => WebDriver (SRWS.RWST r w s wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> RWST r w s wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)

instance (Monoid w, WebDriver wd) => WebDriver (LRWS.RWST r w s wd) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> RWST r w s wd b
doCommand Method
rm Text
t a
a = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
rm Text
t a
a)