module Test.WebDriver.Capabilities.Platform where

import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import Data.String (fromString)
import Data.Text (Text, toLower, toUpper)

-- | Represents the platformName option of the primary capabilities
data Platform =
  Windows
  | XP
  | Vista
  | Mac
  | Linux
  | Unix
  | Any
  | Other Text
  deriving (Platform -> Platform -> Bool
(Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool) -> Eq Platform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Platform -> Platform -> Bool
== :: Platform -> Platform -> Bool
$c/= :: Platform -> Platform -> Bool
/= :: Platform -> Platform -> Bool
Eq, Int -> Platform -> ShowS
[Platform] -> ShowS
Platform -> String
(Int -> Platform -> ShowS)
-> (Platform -> String) -> ([Platform] -> ShowS) -> Show Platform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Platform -> ShowS
showsPrec :: Int -> Platform -> ShowS
$cshow :: Platform -> String
show :: Platform -> String
$cshowList :: [Platform] -> ShowS
showList :: [Platform] -> ShowS
Show, Eq Platform
Eq Platform =>
(Platform -> Platform -> Ordering)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Platform)
-> (Platform -> Platform -> Platform)
-> Ord Platform
Platform -> Platform -> Bool
Platform -> Platform -> Ordering
Platform -> Platform -> Platform
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 :: Platform -> Platform -> Ordering
compare :: Platform -> Platform -> Ordering
$c< :: Platform -> Platform -> Bool
< :: Platform -> Platform -> Bool
$c<= :: Platform -> Platform -> Bool
<= :: Platform -> Platform -> Bool
$c> :: Platform -> Platform -> Bool
> :: Platform -> Platform -> Bool
$c>= :: Platform -> Platform -> Bool
>= :: Platform -> Platform -> Bool
$cmax :: Platform -> Platform -> Platform
max :: Platform -> Platform -> Platform
$cmin :: Platform -> Platform -> Platform
min :: Platform -> Platform -> Platform
Ord)

instance ToJSON Platform where
  toJSON :: Platform -> Value
toJSON (Other Text
t) = Text -> Value
String Text
t
  toJSON Platform
x = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Text
toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Platform -> String
forall a. Show a => a -> String
show Platform
x

instance FromJSON Platform where
  parseJSON :: Value -> Parser Platform
parseJSON (String Text
jStr) = case Text -> Text
toLower Text
jStr of
    Text
"windows" -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Platform
Windows
    Text
"xp" -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Platform
XP
    Text
"vista" -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Platform
Vista
    Text
"mac" -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Platform
Mac
    Text
"linux" -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Platform
Linux
    Text
"unix" -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Platform
Unix
    Text
"any" -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Platform
Any
    Text
t -> Platform -> Parser Platform
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Platform -> Parser Platform) -> Platform -> Parser Platform
forall a b. (a -> b) -> a -> b
$ Text -> Platform
Other Text
t
  parseJSON Value
v = String -> Value -> Parser Platform
forall a. String -> Value -> Parser a
typeMismatch String
"Platform" Value
v