module Test.WebDriver.JSON
(
(!:)
, parseJSON', fromJSON'
, single, pair, triple
, parsePair, parseTriple
, apResultToWD, aesonResultToWD
) where
import Test.WebDriver.Types
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 Control.Applicative
import Control.Exception.Lifted
import Data.String
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' :: FromJSON a => ByteString -> WD a
parseJSON' = apResultToWD . AP.parse json
fromJSON' :: FromJSON a => Value -> WD a
fromJSON' = aesonResultToWD . fromJSON
(!:) :: FromJSON a => Object -> Text -> WD a
o !: k = aesonResultToWD $ parse (.: k) o
parsePair :: (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 :: (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 :: FromJSON a => AP.Result Value -> WD a
apResultToWD p = case p of
Done _ res -> fromJSON' res
Fail _ _ err -> throwIO $ BadJSON err
aesonResultToWD :: Aeson.Result a -> WD a
aesonResultToWD r = case r of
Success val -> return val
Error err -> throwIO $ BadJSON err