module Test.WebDriver.Commands.SeleniumSpecific.HTML5 (
  -- * HTML 5 Web Storage
  storageSize
  , getAllKeys
  , deleteAllKeys
  , getKey
  , setKey
  , deleteKey
  , WebStorageType(..)

  -- * HTML 5 Application Cache
  , ApplicationCacheStatus(..)
  , getApplicationCacheStatus
  ) where

import Data.Aeson as A
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Stack
import Test.WebDriver.JSON
import Test.WebDriver.Types
import Test.WebDriver.Util.Commands


-- | Get the current number of keys in a web storage area.
storageSize :: (HasCallStack, WebDriver wd) => WebStorageType -> wd Integer
storageSize :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WebStorageType -> wd Integer
storageSize WebStorageType
s = Method -> WebStorageType -> Text -> Value -> wd Integer
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand Method
methodGet WebStorageType
s Text
"/size" Value
Null

-- | Get a list of all keys from a web storage area.
getAllKeys :: (HasCallStack, WebDriver wd) => WebStorageType -> wd [Text]
getAllKeys :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WebStorageType -> wd [Text]
getAllKeys WebStorageType
s = Method -> WebStorageType -> Text -> Value -> wd [Text]
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand Method
methodGet WebStorageType
s Text
"" Value
Null

-- | Delete all keys within a given web storage area.
deleteAllKeys :: (HasCallStack, WebDriver wd) => WebStorageType -> wd ()
deleteAllKeys :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WebStorageType -> wd ()
deleteAllKeys WebStorageType
s = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ()) -> wd NoReturn -> wd ()
forall a b. (a -> b) -> a -> b
$ Method -> WebStorageType -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand Method
methodDelete WebStorageType
s Text
"" Value
Null

-- | An HTML 5 storage type
data WebStorageType = LocalStorage | SessionStorage
  deriving (WebStorageType -> WebStorageType -> Bool
(WebStorageType -> WebStorageType -> Bool)
-> (WebStorageType -> WebStorageType -> Bool) -> Eq WebStorageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebStorageType -> WebStorageType -> Bool
== :: WebStorageType -> WebStorageType -> Bool
$c/= :: WebStorageType -> WebStorageType -> Bool
/= :: WebStorageType -> WebStorageType -> Bool
Eq, Int -> WebStorageType -> ShowS
[WebStorageType] -> ShowS
WebStorageType -> String
(Int -> WebStorageType -> ShowS)
-> (WebStorageType -> String)
-> ([WebStorageType] -> ShowS)
-> Show WebStorageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WebStorageType -> ShowS
showsPrec :: Int -> WebStorageType -> ShowS
$cshow :: WebStorageType -> String
show :: WebStorageType -> String
$cshowList :: [WebStorageType] -> ShowS
showList :: [WebStorageType] -> ShowS
Show, Eq WebStorageType
Eq WebStorageType =>
(WebStorageType -> WebStorageType -> Ordering)
-> (WebStorageType -> WebStorageType -> Bool)
-> (WebStorageType -> WebStorageType -> Bool)
-> (WebStorageType -> WebStorageType -> Bool)
-> (WebStorageType -> WebStorageType -> Bool)
-> (WebStorageType -> WebStorageType -> WebStorageType)
-> (WebStorageType -> WebStorageType -> WebStorageType)
-> Ord WebStorageType
WebStorageType -> WebStorageType -> Bool
WebStorageType -> WebStorageType -> Ordering
WebStorageType -> WebStorageType -> WebStorageType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WebStorageType -> WebStorageType -> Ordering
compare :: WebStorageType -> WebStorageType -> Ordering
$c< :: WebStorageType -> WebStorageType -> Bool
< :: WebStorageType -> WebStorageType -> Bool
$c<= :: WebStorageType -> WebStorageType -> Bool
<= :: WebStorageType -> WebStorageType -> Bool
$c> :: WebStorageType -> WebStorageType -> Bool
> :: WebStorageType -> WebStorageType -> Bool
$c>= :: WebStorageType -> WebStorageType -> Bool
>= :: WebStorageType -> WebStorageType -> Bool
$cmax :: WebStorageType -> WebStorageType -> WebStorageType
max :: WebStorageType -> WebStorageType -> WebStorageType
$cmin :: WebStorageType -> WebStorageType -> WebStorageType
min :: WebStorageType -> WebStorageType -> WebStorageType
Ord, WebStorageType
WebStorageType -> WebStorageType -> Bounded WebStorageType
forall a. a -> a -> Bounded a
$cminBound :: WebStorageType
minBound :: WebStorageType
$cmaxBound :: WebStorageType
maxBound :: WebStorageType
Bounded, Int -> WebStorageType
WebStorageType -> Int
WebStorageType -> [WebStorageType]
WebStorageType -> WebStorageType
WebStorageType -> WebStorageType -> [WebStorageType]
WebStorageType
-> WebStorageType -> WebStorageType -> [WebStorageType]
(WebStorageType -> WebStorageType)
-> (WebStorageType -> WebStorageType)
-> (Int -> WebStorageType)
-> (WebStorageType -> Int)
-> (WebStorageType -> [WebStorageType])
-> (WebStorageType -> WebStorageType -> [WebStorageType])
-> (WebStorageType -> WebStorageType -> [WebStorageType])
-> (WebStorageType
    -> WebStorageType -> WebStorageType -> [WebStorageType])
-> Enum WebStorageType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: WebStorageType -> WebStorageType
succ :: WebStorageType -> WebStorageType
$cpred :: WebStorageType -> WebStorageType
pred :: WebStorageType -> WebStorageType
$ctoEnum :: Int -> WebStorageType
toEnum :: Int -> WebStorageType
$cfromEnum :: WebStorageType -> Int
fromEnum :: WebStorageType -> Int
$cenumFrom :: WebStorageType -> [WebStorageType]
enumFrom :: WebStorageType -> [WebStorageType]
$cenumFromThen :: WebStorageType -> WebStorageType -> [WebStorageType]
enumFromThen :: WebStorageType -> WebStorageType -> [WebStorageType]
$cenumFromTo :: WebStorageType -> WebStorageType -> [WebStorageType]
enumFromTo :: WebStorageType -> WebStorageType -> [WebStorageType]
$cenumFromThenTo :: WebStorageType
-> WebStorageType -> WebStorageType -> [WebStorageType]
enumFromThenTo :: WebStorageType
-> WebStorageType -> WebStorageType -> [WebStorageType]
Enum)

-- | Get the value associated with a key in the given web storage area.
-- Unset keys result in empty strings, since the Web Storage spec
-- makes no distinction between the empty string and an undefined value.
getKey :: (HasCallStack, WebDriver wd) => WebStorageType -> Text ->  wd Text
getKey :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WebStorageType -> Text -> wd Text
getKey WebStorageType
s Text
k = Method -> WebStorageType -> Text -> Value -> wd Text
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand Method
methodGet WebStorageType
s (Text
"/key/" Text -> Text -> Text
`T.append` Text -> Text
urlEncode Text
k) Value
Null

-- | Set a key in the given web storage area.
setKey :: (HasCallStack, WebDriver wd) => WebStorageType -> Text -> Text -> wd Text
setKey :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WebStorageType -> Text -> Text -> wd Text
setKey WebStorageType
s Text
k Text
v = Method -> WebStorageType -> Text -> Value -> wd Text
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand Method
methodPost WebStorageType
s Text
"" (Value -> wd Text) -> ([Pair] -> Value) -> [Pair] -> wd Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
object ([Pair] -> wd Text) -> [Pair] -> wd Text
forall a b. (a -> b) -> a -> b
$ [Key
"key"   Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
k,
                                                      Key
"value" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
v ]
-- | Delete a key in the given web storage area.
deleteKey :: (HasCallStack, WebDriver wd) => WebStorageType -> Text -> wd ()
deleteKey :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WebStorageType -> Text -> wd ()
deleteKey WebStorageType
s Text
k = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ()) -> wd NoReturn -> wd ()
forall a b. (a -> b) -> a -> b
$ Method -> WebStorageType -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand Method
methodPost WebStorageType
s (Text
"/key/" Text -> Text -> Text
`T.append` Text -> Text
urlEncode Text
k) Value
Null

-- | A wrapper around 'doSessCommand' to create web storage requests.
doStorageCommand :: (
  HasCallStack, WebDriver wd, ToJSON a, FromJSON b
  ) => Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand :: forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WebStorageType -> Text -> a -> wd b
doStorageCommand Method
m WebStorageType
s Text
path a
a = Method -> Text -> a -> wd b
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
m ([Text] -> Text
T.concat [Text
"/", Text
s', Text
path]) a
a
  where s' :: Text
s' = case WebStorageType
s of
          WebStorageType
LocalStorage -> Text
"local_storage"
          WebStorageType
SessionStorage -> Text
"session_storage"

data ApplicationCacheStatus =
  Uncached
  | Idle
  | Checking
  | Downloading
  | UpdateReady
  | Obsolete
  deriving (ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
(ApplicationCacheStatus -> ApplicationCacheStatus -> Bool)
-> (ApplicationCacheStatus -> ApplicationCacheStatus -> Bool)
-> Eq ApplicationCacheStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
== :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
$c/= :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
/= :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
Eq, Int -> ApplicationCacheStatus
ApplicationCacheStatus -> Int
ApplicationCacheStatus -> [ApplicationCacheStatus]
ApplicationCacheStatus -> ApplicationCacheStatus
ApplicationCacheStatus
-> ApplicationCacheStatus -> [ApplicationCacheStatus]
ApplicationCacheStatus
-> ApplicationCacheStatus
-> ApplicationCacheStatus
-> [ApplicationCacheStatus]
(ApplicationCacheStatus -> ApplicationCacheStatus)
-> (ApplicationCacheStatus -> ApplicationCacheStatus)
-> (Int -> ApplicationCacheStatus)
-> (ApplicationCacheStatus -> Int)
-> (ApplicationCacheStatus -> [ApplicationCacheStatus])
-> (ApplicationCacheStatus
    -> ApplicationCacheStatus -> [ApplicationCacheStatus])
-> (ApplicationCacheStatus
    -> ApplicationCacheStatus -> [ApplicationCacheStatus])
-> (ApplicationCacheStatus
    -> ApplicationCacheStatus
    -> ApplicationCacheStatus
    -> [ApplicationCacheStatus])
-> Enum ApplicationCacheStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ApplicationCacheStatus -> ApplicationCacheStatus
succ :: ApplicationCacheStatus -> ApplicationCacheStatus
$cpred :: ApplicationCacheStatus -> ApplicationCacheStatus
pred :: ApplicationCacheStatus -> ApplicationCacheStatus
$ctoEnum :: Int -> ApplicationCacheStatus
toEnum :: Int -> ApplicationCacheStatus
$cfromEnum :: ApplicationCacheStatus -> Int
fromEnum :: ApplicationCacheStatus -> Int
$cenumFrom :: ApplicationCacheStatus -> [ApplicationCacheStatus]
enumFrom :: ApplicationCacheStatus -> [ApplicationCacheStatus]
$cenumFromThen :: ApplicationCacheStatus
-> ApplicationCacheStatus -> [ApplicationCacheStatus]
enumFromThen :: ApplicationCacheStatus
-> ApplicationCacheStatus -> [ApplicationCacheStatus]
$cenumFromTo :: ApplicationCacheStatus
-> ApplicationCacheStatus -> [ApplicationCacheStatus]
enumFromTo :: ApplicationCacheStatus
-> ApplicationCacheStatus -> [ApplicationCacheStatus]
$cenumFromThenTo :: ApplicationCacheStatus
-> ApplicationCacheStatus
-> ApplicationCacheStatus
-> [ApplicationCacheStatus]
enumFromThenTo :: ApplicationCacheStatus
-> ApplicationCacheStatus
-> ApplicationCacheStatus
-> [ApplicationCacheStatus]
Enum, ApplicationCacheStatus
ApplicationCacheStatus
-> ApplicationCacheStatus -> Bounded ApplicationCacheStatus
forall a. a -> a -> Bounded a
$cminBound :: ApplicationCacheStatus
minBound :: ApplicationCacheStatus
$cmaxBound :: ApplicationCacheStatus
maxBound :: ApplicationCacheStatus
Bounded, Eq ApplicationCacheStatus
Eq ApplicationCacheStatus =>
(ApplicationCacheStatus -> ApplicationCacheStatus -> Ordering)
-> (ApplicationCacheStatus -> ApplicationCacheStatus -> Bool)
-> (ApplicationCacheStatus -> ApplicationCacheStatus -> Bool)
-> (ApplicationCacheStatus -> ApplicationCacheStatus -> Bool)
-> (ApplicationCacheStatus -> ApplicationCacheStatus -> Bool)
-> (ApplicationCacheStatus
    -> ApplicationCacheStatus -> ApplicationCacheStatus)
-> (ApplicationCacheStatus
    -> ApplicationCacheStatus -> ApplicationCacheStatus)
-> Ord ApplicationCacheStatus
ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
ApplicationCacheStatus -> ApplicationCacheStatus -> Ordering
ApplicationCacheStatus
-> ApplicationCacheStatus -> ApplicationCacheStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ApplicationCacheStatus -> ApplicationCacheStatus -> Ordering
compare :: ApplicationCacheStatus -> ApplicationCacheStatus -> Ordering
$c< :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
< :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
$c<= :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
<= :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
$c> :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
> :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
$c>= :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
>= :: ApplicationCacheStatus -> ApplicationCacheStatus -> Bool
$cmax :: ApplicationCacheStatus
-> ApplicationCacheStatus -> ApplicationCacheStatus
max :: ApplicationCacheStatus
-> ApplicationCacheStatus -> ApplicationCacheStatus
$cmin :: ApplicationCacheStatus
-> ApplicationCacheStatus -> ApplicationCacheStatus
min :: ApplicationCacheStatus
-> ApplicationCacheStatus -> ApplicationCacheStatus
Ord, Int -> ApplicationCacheStatus -> ShowS
[ApplicationCacheStatus] -> ShowS
ApplicationCacheStatus -> String
(Int -> ApplicationCacheStatus -> ShowS)
-> (ApplicationCacheStatus -> String)
-> ([ApplicationCacheStatus] -> ShowS)
-> Show ApplicationCacheStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplicationCacheStatus -> ShowS
showsPrec :: Int -> ApplicationCacheStatus -> ShowS
$cshow :: ApplicationCacheStatus -> String
show :: ApplicationCacheStatus -> String
$cshowList :: [ApplicationCacheStatus] -> ShowS
showList :: [ApplicationCacheStatus] -> ShowS
Show, ReadPrec [ApplicationCacheStatus]
ReadPrec ApplicationCacheStatus
Int -> ReadS ApplicationCacheStatus
ReadS [ApplicationCacheStatus]
(Int -> ReadS ApplicationCacheStatus)
-> ReadS [ApplicationCacheStatus]
-> ReadPrec ApplicationCacheStatus
-> ReadPrec [ApplicationCacheStatus]
-> Read ApplicationCacheStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ApplicationCacheStatus
readsPrec :: Int -> ReadS ApplicationCacheStatus
$creadList :: ReadS [ApplicationCacheStatus]
readList :: ReadS [ApplicationCacheStatus]
$creadPrec :: ReadPrec ApplicationCacheStatus
readPrec :: ReadPrec ApplicationCacheStatus
$creadListPrec :: ReadPrec [ApplicationCacheStatus]
readListPrec :: ReadPrec [ApplicationCacheStatus]
Read)

instance FromJSON ApplicationCacheStatus where
  parseJSON :: Value -> Parser ApplicationCacheStatus
parseJSON Value
val = do
    Integer
n <- Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
    case Integer
n :: Integer of
      Integer
0 -> ApplicationCacheStatus -> Parser ApplicationCacheStatus
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationCacheStatus
Uncached
      Integer
1 -> ApplicationCacheStatus -> Parser ApplicationCacheStatus
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationCacheStatus
Idle
      Integer
2 -> ApplicationCacheStatus -> Parser ApplicationCacheStatus
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationCacheStatus
Checking
      Integer
3 -> ApplicationCacheStatus -> Parser ApplicationCacheStatus
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationCacheStatus
Downloading
      Integer
4 -> ApplicationCacheStatus -> Parser ApplicationCacheStatus
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationCacheStatus
UpdateReady
      Integer
5 -> ApplicationCacheStatus -> Parser ApplicationCacheStatus
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationCacheStatus
Obsolete
      Integer
err -> String -> Parser ApplicationCacheStatus
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ApplicationCacheStatus)
-> String -> Parser ApplicationCacheStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid JSON for ApplicationCacheStatus: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
err

instance ToJSON ApplicationCacheStatus where
  toJSON :: ApplicationCacheStatus -> Value
toJSON ApplicationCacheStatus
Uncached = Scientific -> Value
A.Number Scientific
0
  toJSON ApplicationCacheStatus
Idle = Scientific -> Value
A.Number Scientific
1
  toJSON ApplicationCacheStatus
Checking = Scientific -> Value
A.Number Scientific
2
  toJSON ApplicationCacheStatus
Downloading = Scientific -> Value
A.Number Scientific
3
  toJSON ApplicationCacheStatus
UpdateReady = Scientific -> Value
A.Number Scientific
4
  toJSON ApplicationCacheStatus
Obsolete = Scientific -> Value
A.Number Scientific
5

getApplicationCacheStatus :: (HasCallStack, WebDriver wd) => wd ApplicationCacheStatus
getApplicationCacheStatus :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
wd ApplicationCacheStatus
getApplicationCacheStatus = Method -> Text -> Value -> wd ApplicationCacheStatus
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodGet Text
"/application_cache/status" Value
Null