{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-warn-deriving-typeable #-}

-- | A collection of convenience functions for using and parsing JSON values
-- within 'WD'. All monadic parse errors are converted to asynchronous
-- 'BadJSON' exceptions.
--
-- These functions are used internally to implement webdriver commands, and may
-- be useful for implementing non-standard commands.
module Test.WebDriver.JSON (
  -- * Access a JSON object key
  (!:)
  , (.:??)

  -- * Conversion from JSON within WD
  -- | Apostrophes are used to disambiguate these functions
  -- from their "Data.Aeson" counterparts.
  , parseJSON'
  , fromJSON'

  -- * Tuple functions
  -- | Convenience functions for working with tuples.
   -- ** JSON object constructors
  , single
  , pair
  , triple
  -- ** Extracting JSON objects into tuples
  , parseTriple

  -- * Conversion from parser results to WD
  -- | These functions are used to implement the other functions
  -- in this module, and could be used to implement other JSON
  -- convenience functions
  , apResultToWD
  , aesonResultToWD

  -- * Parse exception
  , BadJSON(..)

  -- * parsing commands with no return value
  , noReturn
  , ignoreReturn
  , aesonKeyFromText
  , NoReturn(..)

  -- * JSON helpers
  , noObject
  ) where

import Control.Applicative
import Control.Monad (join, void)
import Control.Monad.IO.Class
import Data.Aeson as Aeson
import Data.Aeson.Types
import Data.Attoparsec.ByteString.Lazy (Result(..))
import qualified Data.Attoparsec.ByteString.Lazy as AP
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.String
import Data.Text (Text)
import Prelude -- hides some "unused import" warnings
import Test.WebDriver.Types (WebDriver)
import Test.WebDriver.Util.Aeson (aesonKeyFromText)
import UnliftIO.Exception

#if MIN_VERSION_aeson(2,2,0)
-- This comes from the attoparsec-aeson package
import Data.Aeson.Parser (json)
#endif

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap          as HM
#else
import qualified Data.HashMap.Strict        as HM
#endif


-- | An error occured when parsing a JSON value.
newtype BadJSON = BadJSON String
  deriving (BadJSON -> BadJSON -> Bool
(BadJSON -> BadJSON -> Bool)
-> (BadJSON -> BadJSON -> Bool) -> Eq BadJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BadJSON -> BadJSON -> Bool
== :: BadJSON -> BadJSON -> Bool
$c/= :: BadJSON -> BadJSON -> Bool
/= :: BadJSON -> BadJSON -> Bool
Eq, Int -> BadJSON -> ShowS
[BadJSON] -> ShowS
BadJSON -> String
(Int -> BadJSON -> ShowS)
-> (BadJSON -> String) -> ([BadJSON] -> ShowS) -> Show BadJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BadJSON -> ShowS
showsPrec :: Int -> BadJSON -> ShowS
$cshow :: BadJSON -> String
show :: BadJSON -> String
$cshowList :: [BadJSON] -> ShowS
showList :: [BadJSON] -> ShowS
Show, Typeable)
instance Exception BadJSON

-- | A type indicating that we expect no return value from the webdriver request.
-- Its FromJSON instance parses successfully for any values that indicate lack of
-- a return value (a notion that varies from server to server).
data NoReturn = NoReturn

instance FromJSON NoReturn where
  parseJSON :: Value -> Parser NoReturn
parseJSON Value
Null                    = NoReturn -> Parser NoReturn
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return NoReturn
NoReturn
  parseJSON (Object Object
o) | Object -> Bool
forall v. KeyMap v -> Bool
HM.null Object
o  = NoReturn -> Parser NoReturn
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return NoReturn
NoReturn
  parseJSON (String Text
"")             = NoReturn -> Parser NoReturn
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return NoReturn
NoReturn
  parseJSON Value
other                   = String -> Value -> Parser NoReturn
forall a. String -> Value -> Parser a
typeMismatch String
"no return value" Value
other

instance ToJSON NoReturn where
  toJSON :: NoReturn -> Value
toJSON NoReturn
NoReturn = Text -> Value
Aeson.String Text
"<no return>"

-- | Convenience function to handle webdriver commands with no return value.
noReturn :: WebDriver m => m NoReturn -> m ()
noReturn :: forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn = m NoReturn -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

-- | Convenience function to ignore result of a webdriver command.
ignoreReturn :: WebDriver m => m Value -> m ()
ignoreReturn :: forall (m :: * -> *). WebDriver m => m Value -> m ()
ignoreReturn = m Value -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

-- | Construct a singleton JSON 'object' from a key and value.
single :: ToJSON a => Text -> a -> Value
single :: forall a. ToJSON a => Text -> a -> Value
single Text
a a
x = [Pair] -> Value
object [Text -> Key
aesonKeyFromText Text
a Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
x]

-- | Construct a 2-element JSON 'object' from a pair of keys and a pair of
-- values.
pair :: (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair :: forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
a, Text
b) (a
x,b
y) = [Pair] -> Value
object [Text -> Key
aesonKeyFromText Text
a Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
x, Text -> Key
aesonKeyFromText Text
b Key -> b -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= b
y]

-- | Construct a 3-element JSON 'object' from a triple of keys and a triple of
-- values.
triple :: (ToJSON a, ToJSON b, ToJSON c) => (Text, Text, Text) -> (a, b, c) -> Value
triple :: forall a b c.
(ToJSON a, ToJSON b, ToJSON c) =>
(Text, Text, Text) -> (a, b, c) -> Value
triple (Text
a, Text
b, Text
c) (a
x, b
y, c
z) = [Pair] -> Value
object [Text -> Key
aesonKeyFromText Text
a Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
x, Text -> Key
aesonKeyFromText Text
bKey -> b -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= b
y, Text -> Key
aesonKeyFromText Text
c Key -> c -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= c
z]

-- | Parse a lazy 'ByteString' as a top-level JSON 'Value', then convert it to an
-- instance of 'FromJSON'..
parseJSON' :: MonadIO m => FromJSON a => ByteString -> m a
parseJSON' :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
ByteString -> m a
parseJSON' = Result Value -> m a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Result Value -> m a
apResultToWD (Result Value -> m a)
-> (ByteString -> Result Value) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Value -> ByteString -> Result Value
forall a. Parser a -> ByteString -> Result a
AP.parse Parser Value
json

-- | Convert a JSON 'Value' to an instance of 'FromJSON'.
fromJSON' :: MonadIO m => FromJSON a => Value -> m a
fromJSON' :: forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Value -> m a
fromJSON' = Result a -> m a
forall (m :: * -> *) a. MonadIO m => Result a -> m a
aesonResultToWD (Result a -> m a) -> (Value -> Result a) -> Value -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON

-- | This operator is a wrapper over Aeson's '.:' operator.
(!:) :: (MonadIO m, FromJSON a) => Object -> Text -> m a
Object
o !: :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Object -> Text -> m a
!: Text
k = Result a -> m a
forall (m :: * -> *) a. MonadIO m => Result a -> m a
aesonResultToWD (Result a -> m a) -> Result a -> m a
forall a b. (a -> b) -> a -> b
$ (Object -> Parser a) -> Object -> Result a
forall a b. (a -> Parser b) -> a -> Result b
parse (Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Text -> Key
aesonKeyFromText Text
k) Object
o

-- | Due to a breaking change in the '.:?' operator of aeson 0.10 (see <https://github.com/bos/aeson/issues/287>) that was subsequently reverted, this operator
-- was added to provide consistent behavior compatible with all aeson versions. If the field is either missing or `Null`, this operator should return a `Nothing` result.
(.:??) :: FromJSON a => Object -> Text -> Parser (Maybe a)
Object
o .:?? :: forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?? Text
k = (Maybe (Maybe a) -> Maybe a)
-> Parser (Maybe (Maybe a)) -> Parser (Maybe a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Object
o Object -> Key -> Parser (Maybe (Maybe a))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Text -> Key
aesonKeyFromText Text
k)

-- | Parse a JSON Object as a triple. The first three string arguments
-- specify the keys to extract from the object. The fourth string is the name
-- of the calling function, for better error reporting.
parseTriple :: (
  MonadIO m, FromJSON a, FromJSON b, FromJSON c
  ) => String -> String -> String ->  String -> Value -> m (a, b, c)
parseTriple :: forall (m :: * -> *) a b c.
(MonadIO m, FromJSON a, FromJSON b, FromJSON c) =>
String -> String -> String -> String -> Value -> m (a, b, c)
parseTriple String
a String
b String
c String
funcName Value
v =
  case Value
v of
    Object Object
o -> (,,) (a -> b -> c -> (a, b, c)) -> m a -> m (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> m a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Object -> Text -> m a
!: String -> Text
forall a. IsString a => String -> a
fromString String
a
                     m (b -> c -> (a, b, c)) -> m b -> m (c -> (a, b, c))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> m b
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Object -> Text -> m a
!: String -> Text
forall a. IsString a => String -> a
fromString String
b
                     m (c -> (a, b, c)) -> m c -> m (a, b, c)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> m c
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Object -> Text -> m a
!: String -> Text
forall a. IsString a => String -> a
fromString String
c
    Value
_        -> BadJSON -> m (a, b, c)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (BadJSON -> m (a, b, c))
-> (String -> BadJSON) -> String -> m (a, b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BadJSON
BadJSON (String -> m (a, b, c)) -> String -> m (a, b, c)
forall a b. (a -> b) -> a -> b
$ String
funcName String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
": cannot parse non-object JSON response as a (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") pair"

-- | Convert an attoparsec parser result to 'WD'.
apResultToWD :: (MonadIO m, FromJSON a) => AP.Result Value -> m a
apResultToWD :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Result Value -> m a
apResultToWD Result Value
p = case Result Value
p of
  Done ByteString
_ Value
res -> Value -> m a
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Value -> m a
fromJSON' Value
res
  Fail ByteString
_ [String]
_ String
err -> BadJSON -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (BadJSON -> m a) -> BadJSON -> m a
forall a b. (a -> b) -> a -> b
$ String -> BadJSON
BadJSON String
err

-- |  Convert an Aeson parser result to 'WD'.
aesonResultToWD :: (MonadIO m) => Aeson.Result a -> m a
aesonResultToWD :: forall (m :: * -> *) a. MonadIO m => Result a -> m a
aesonResultToWD Result a
r = case Result a
r of
  Success a
val -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
  Error String
err -> BadJSON -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (BadJSON -> m a) -> BadJSON -> m a
forall a b. (a -> b) -> a -> b
$ String -> BadJSON
BadJSON String
err

-- Selenium 3.x doesn't seem to like receiving Null for click parameter
noObject :: Value
noObject :: Value
noObject = Object -> Value
Object Object
forall a. Monoid a => a
mempty