Add missing HTTP valid methods to XMLHttpRequest

GHCJS/Foreign/Export.hs

@@ -22,18 +22,37 @@ module GHCJS.Foreign.Export
 import Control.Exception (bracket)
 import GHC.Exts (Any)
 import GHC.Fingerprint
+import Data.Proxy (Proxy(..))
 import Data.Typeable
 import Data.Typeable.Internal (TypeRep(..))
 import Data.Word
 import Unsafe.Coerce
 import qualified GHC.Exts as Exts
 
 import GHCJS.Prim
+import GHCJS.Marshal (ToJSVal(..), FromJSVal(..))
+import GHCJS.Marshal.Pure (PToJSVal(..))
 import GHCJS.Types
 
 newtype Export a = Export JSVal
+
 instance IsJSVal (Export a)
 
+instance PToJSVal (Export a) where
+  pToJSVal (Export x) = x
+
+instance ToJSVal (Export a) where
+  toJSVal (Export x) = return x
+
+instance Typeable a => FromJSVal (Export a) where
+  fromJSVal x = do
+    let TypeRep (Fingerprint w1 w2) _ _ _ = typeRep (Proxy :: Proxy a)
+    r <- js_derefExport w1 w2 (Export x)
+    if isNull r
+      then return Nothing
+      else return $ Just $ Export x
+  fromJSValUnchecked = return . Export
+
 {- |
      Export any Haskell value to a JavaScript reference without evaluating it.
      The JavaScript reference can be passed to foreign code and used to retrieve

GHCJS/Marshal.hs

@@ -70,6 +70,11 @@ instance FromJSVal () where
   {-# INLINE fromJSValUnchecked #-}
   fromJSVal = fromJSVal_pure
 --    {-# INLINE fromJSVal #-}
+instance FromJSVal (AI.SomeJSArray m) where
+    fromJSVal x = case jsonTypeOf x of
+        JSONArray -> return $ Just $ AI.SomeJSArray x
+        _ -> return Nothing
+    {-# INLINE fromJSVal #-}
 instance FromJSVal a => FromJSVal [a] where
     fromJSVal = fromJSValListOf
     {-# INLINE fromJSVal #-}
@@ -276,6 +281,9 @@ instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f) => T
 instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f, ToJSVal g) => ToJSVal (a,b,c,d,e,f,g) where
     toJSVal (a,b,c,d,e,f,g) = join $ arr7 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e <*> toJSVal f <*> toJSVal g
     {-# INLINE toJSVal #-}
+instance ToJSVal (AI.SomeJSArray m) where
+    toJSVal = return . jsval
+    {-# INLINE toJSVal #-}
 
 foreign import javascript unsafe "[$1]"                   arr1     :: JSVal -> IO JSVal
 foreign import javascript unsafe "[$1,$2]"                arr2     :: JSVal -> JSVal -> IO JSVal

GHCJS/Marshal/Pure.hs

@@ -46,6 +46,8 @@ import qualified GHCJS.Prim as Prim
 import           GHCJS.Foreign.Internal
 import           GHCJS.Marshal.Internal
 
+import           JavaScript.Array.Internal
+
 {-
 type family IsPureShared a where
   IsPureShared PureExclusive = False
@@ -131,6 +133,9 @@ instance PToJSVal Float     where pToJSVal (F# x)   = floatToJSVal x
 instance PToJSVal Double    where pToJSVal (D# x)   = doubleToJSVal x
                                   {-# INLINE pToJSVal #-}
 
+instance PToJSVal JSArray   where pToJSVal = jsval
+                                  {-# INLINE pToJSVal #-}
+
 instance PToJSVal a => PToJSVal (Maybe a) where
     pToJSVal Nothing  = jsNull
     pToJSVal (Just a) = pToJSVal a

JavaScript/Array/Internal.hs

@@ -24,6 +24,7 @@ newtype SomeJSArray (m :: MutabilityType s) = SomeJSArray JSVal
 instance IsJSVal (SomeJSArray m)
 
 type JSArray        = SomeJSArray Immutable
+
 type MutableJSArray = SomeJSArray Mutable
 
 type STJSArray s    = SomeJSArray (STMutable s)

JavaScript/Web/XMLHttpRequest.hs

@@ -52,7 +52,13 @@ import JavaScript.Web.Blob.Internal
 
 import JavaScript.Web.File
 
-data Method = GET | POST | PUT | DELETE
+data Method = GET
+            | POST
+            | HEAD
+            | PUT
+            | DELETE
+            | OPTIONS
+            | PATCH
   deriving (Show, Eq, Ord, Enum)
 
 data XHRError = XHRError String
@@ -62,10 +68,13 @@ data XHRError = XHRError String
 instance Exception XHRError
 
 methodJSString :: Method -> JSString
-methodJSString GET    = "GET"
-methodJSString POST   = "POST"
-methodJSString PUT    = "PUT"
-methodJSString DELETE = "DELETE"
+methodJSString GET     = "GET"
+methodJSString POST    = "POST"
+methodJSString HEAD    = "HEAD"
+methodJSString PUT     = "PUT"
+methodJSString DELETE  = "DELETE"
+methodJSString OPTIONS = "OPTIONS"
+methodJSString PATCH   = "PATCH"
 
 type Header = (JSString, JSString)
 
@@ -135,11 +144,11 @@ xhr req = js_createXHR >>= \x ->
         js_setResponseType
           (getResponseTypeString (Proxy :: Proxy a)) x
         forM_ (reqHeaders req) (\(n,v) -> js_setRequestHeader n v x)
-        
+
         case reqWithCredentials req of
           True  -> js_setWithCredentials x
           False -> return ()
-        
+
         r <- case reqData req of
           NoData                            ->
             js_send0 x

ghcjs-base.cabal

@@ -129,7 +129,7 @@ library
                    integer-gmp,
                    bytestring           >= 0.10 && < 0.11,
                    text                 >= 1.1  && < 1.3,
-                   aeson                >= 0.8  && < 0.12,
+                   aeson                >= 0.8  && < 1.1,
                    scientific           >= 0.3  && < 0.4,
                    vector               >= 0.10 && < 0.12,
                    containers           >= 0.5  && < 0.6,