{-# LANGUAGE DeriveDataTypeable #-}

module Reflex.Dom.Xhr.ResponseType where

import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Typeable
import GHCJS.DOM.Blob (Blob)

data XhrResponseType
  = XhrResponseType_Default
  | XhrResponseType_ArrayBuffer
  | XhrResponseType_Blob
  | XhrResponseType_Text
  deriving (Int -> XhrResponseType -> ShowS
[XhrResponseType] -> ShowS
XhrResponseType -> String
(Int -> XhrResponseType -> ShowS)
-> (XhrResponseType -> String)
-> ([XhrResponseType] -> ShowS)
-> Show XhrResponseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XhrResponseType] -> ShowS
$cshowList :: [XhrResponseType] -> ShowS
show :: XhrResponseType -> String
$cshow :: XhrResponseType -> String
showsPrec :: Int -> XhrResponseType -> ShowS
$cshowsPrec :: Int -> XhrResponseType -> ShowS
Show, ReadPrec [XhrResponseType]
ReadPrec XhrResponseType
Int -> ReadS XhrResponseType
ReadS [XhrResponseType]
(Int -> ReadS XhrResponseType)
-> ReadS [XhrResponseType]
-> ReadPrec XhrResponseType
-> ReadPrec [XhrResponseType]
-> Read XhrResponseType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XhrResponseType]
$creadListPrec :: ReadPrec [XhrResponseType]
readPrec :: ReadPrec XhrResponseType
$creadPrec :: ReadPrec XhrResponseType
readList :: ReadS [XhrResponseType]
$creadList :: ReadS [XhrResponseType]
readsPrec :: Int -> ReadS XhrResponseType
$creadsPrec :: Int -> ReadS XhrResponseType
Read, XhrResponseType -> XhrResponseType -> Bool
(XhrResponseType -> XhrResponseType -> Bool)
-> (XhrResponseType -> XhrResponseType -> Bool)
-> Eq XhrResponseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XhrResponseType -> XhrResponseType -> Bool
$c/= :: XhrResponseType -> XhrResponseType -> Bool
== :: XhrResponseType -> XhrResponseType -> Bool
$c== :: XhrResponseType -> XhrResponseType -> Bool
Eq, Eq XhrResponseType
Eq XhrResponseType =>
(XhrResponseType -> XhrResponseType -> Ordering)
-> (XhrResponseType -> XhrResponseType -> Bool)
-> (XhrResponseType -> XhrResponseType -> Bool)
-> (XhrResponseType -> XhrResponseType -> Bool)
-> (XhrResponseType -> XhrResponseType -> Bool)
-> (XhrResponseType -> XhrResponseType -> XhrResponseType)
-> (XhrResponseType -> XhrResponseType -> XhrResponseType)
-> Ord XhrResponseType
XhrResponseType -> XhrResponseType -> Bool
XhrResponseType -> XhrResponseType -> Ordering
XhrResponseType -> XhrResponseType -> XhrResponseType
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
min :: XhrResponseType -> XhrResponseType -> XhrResponseType
$cmin :: XhrResponseType -> XhrResponseType -> XhrResponseType
max :: XhrResponseType -> XhrResponseType -> XhrResponseType
$cmax :: XhrResponseType -> XhrResponseType -> XhrResponseType
>= :: XhrResponseType -> XhrResponseType -> Bool
$c>= :: XhrResponseType -> XhrResponseType -> Bool
> :: XhrResponseType -> XhrResponseType -> Bool
$c> :: XhrResponseType -> XhrResponseType -> Bool
<= :: XhrResponseType -> XhrResponseType -> Bool
$c<= :: XhrResponseType -> XhrResponseType -> Bool
< :: XhrResponseType -> XhrResponseType -> Bool
$c< :: XhrResponseType -> XhrResponseType -> Bool
compare :: XhrResponseType -> XhrResponseType -> Ordering
$ccompare :: XhrResponseType -> XhrResponseType -> Ordering
$cp1Ord :: Eq XhrResponseType
Ord, Typeable)

data XhrResponseBody
  = XhrResponseBody_Default Text
  | XhrResponseBody_Text Text
  | XhrResponseBody_Blob Blob
  | XhrResponseBody_ArrayBuffer ByteString