module Test.WebDriver.JSON
(
(!:)
, parseJSON', fromJSON'
, single, pair, triple
, parsePair, parseTriple
, apResultToWD, aesonResultToWD
, BadJSON(..)
, NoReturn(..)
) where
import Data.Aeson as Aeson
import Data.Aeson.Types
import Data.Text (Text)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Attoparsec.ByteString.Lazy (Result(..))
import qualified Data.Attoparsec.ByteString.Lazy as AP
import qualified Data.HashMap.Strict as HM
import Control.Applicative
import Control.Monad.Trans.Control
import Control.Exception.Lifted
import Data.String
import Data.Typeable
instance Exception BadJSON
newtype BadJSON = BadJSON String
deriving (Eq, Show, Typeable)
data NoReturn = NoReturn
instance FromJSON NoReturn where
parseJSON Null = return NoReturn
parseJSON (Object o) | HM.null o = return NoReturn
parseJSON other = typeMismatch "no return value" other
single :: ToJSON a => Text -> a -> Value
single a x = object [a .= x]
pair :: (ToJSON a, ToJSON b) => (Text,Text) -> (a,b) -> Value
pair (a,b) (x,y) = object [a .= x, b .= y]
triple :: (ToJSON a, ToJSON b, ToJSON c) =>
(Text,Text,Text) -> (a,b,c) -> Value
triple (a,b,c) (x,y,z) = object [a .= x, b.= y, c .= z]
parseJSON' :: MonadBaseControl IO wd => FromJSON a => ByteString -> wd a
parseJSON' = apResultToWD . AP.parse json
fromJSON' :: MonadBaseControl IO wd => FromJSON a => Value -> wd a
fromJSON' = aesonResultToWD . fromJSON
(!:) :: (MonadBaseControl IO wd, FromJSON a) => Object -> Text -> wd a
o !: k = aesonResultToWD $ parse (.: k) o
parsePair :: (MonadBaseControl IO wd, FromJSON a, FromJSON b) =>
String -> String -> String -> Value -> wd (a, b)
parsePair a b funcName v =
case v of
Object o -> (,) <$> o !: fromString a <*> o !: fromString b
_ -> throwIO . BadJSON $ funcName ++
": cannot parse non-object JSON response as a (" ++ a
++ ", " ++ b ++ ") pair" ++ ")"
parseTriple :: (MonadBaseControl IO wd, FromJSON a, FromJSON b, FromJSON c) =>
String -> String -> String -> String -> Value -> wd (a, b, c)
parseTriple a b c funcName v =
case v of
Object o -> (,,) <$> o !: fromString a
<*> o !: fromString b
<*> o !: fromString c
_ -> throwIO . BadJSON $ funcName ++
": cannot parse non-object JSON response as a (" ++ a
++ ", " ++ b ++ ", " ++ c ++ ") pair"
apResultToWD :: (MonadBaseControl IO wd, FromJSON a) => AP.Result Value -> wd a
apResultToWD p = case p of
Done _ res -> fromJSON' res
Fail _ _ err -> throwIO $ BadJSON err
aesonResultToWD :: (MonadBaseControl IO wd) => Aeson.Result a -> wd a
aesonResultToWD r = case r of
Success val -> return val
Error err -> throwIO $ BadJSON err