@@ -374,9 +374,8 @@ performRequestsCT
374performRequestsCT ct reqMeth reqs reqHost trigger = do
374performRequestsCT ct reqMeth reqs reqHost trigger = do
375 resps <- performRequests reqMeth reqs reqHost trigger
375 resps <- performRequests reqMeth reqs reqHost trigger
376 let decodeResp x = first T.pack .
376 let decodeResp x = first T.pack .
377− mimeUnrender ct .
377+ mimeUnrender ct
379− TE.encodeUtf8 =<< note "No body text"
378+ =<< note "No body text"
380 (_xhrResponse_responseText x)
379 (_xhrResponse_responseText x)
381 return $ fmap
380 return $ fmap
382 (\(t,rs) -> ffor rs $ \r -> case r of
381 (\(t,rs) -> ffor rs $ \r -> case r of
@@ -400,21 +399,24 @@ foreign import javascript safe "new DataView($3,$1,$2)"
400foreign import javascript unsafe "console.log($1); $r = JSON['parse']($1);"
399foreign import javascript unsafe "console.log($1); $r = JSON['parse']($1);"
401 js_jsonParse :: JSVal -> JSVal
400 js_jsonParse :: JSVal -> JSVal
403−rawDecode :: (FromJSON a) => BS.ByteString -> Maybe a
402+rawDecode :: (FromJSON a) => T.Text -> Maybe a
404rawDecode bs = do
403rawDecode bs = do
405 -- Below copied from Reflex.Dom.WebSocket.Foreign
404 -- Below copied from Reflex.Dom.WebSocket.Foreign
406 -- tmp <- Just $ unsafePerformIO $ putStrLn ("bs: " ++ BS.unpack bs)
405 -- tmp <- Just $ unsafePerformIO $ putStrLn ("bs: " ++ BS.unpack bs)
407 -- error ("bs: " ++ BS.unpack bs)
406 -- error ("bs: " ++ BS.unpack bs)
408− let (b, off, len) = fromByteString bs
407+ -- let (b, off, len) = fromByteString bs
409 -- x = return $ js_dataView off len $ jsval $ getArrayBuffer b :: _
408 -- x = return $ js_dataView off len $ jsval $ getArrayBuffer b :: _
410 -- tmp <- error (BS.unpack bs)
409 -- tmp <- error (BS.unpack bs)
411− let jsv = if BS.length bs == 0
411+ -- let jsv = if BS.length bs == 0
412− then error "ZERO!!" -- unsafePerformIO $ jsval . getArrayBuffer <$> create 0
412+ -- then unsafePerformIO $ jsval . getArrayBuffer <$> create 0
413− else js_dataView off len $ jsval $ getArrayBuffer b
413+ -- else js_dataView off len $ jsval $ getArrayBuffer b
415+ let jsv = T.textToJSString bs
415 -- let jsv = _ bs
417 -- let jsv = _ bs
416 -- TODO pFromJSVal to avoid unsafePerformIO
418 -- TODO pFromJSVal to avoid unsafePerformIO
417− let res = unsafePerformIO $ try $ aesonFromJSVal $ js_jsonParse jsv
419+ let res = unsafePerformIO $ try $ aesonFromJSVal $ js_jsonParse $ jsval jsv
418 case res of
420 case res of
419 Left (_e :: SomeException) -> Nothing
421 Left (_e :: SomeException) -> Nothing
420 Right (v :: (Maybe Aeson.Value)) -> maybe Nothing go v
422 Right (v :: (Maybe Aeson.Value)) -> maybe Nothing go v
@@ -436,8 +438,7 @@ aesonFromJSVal r = do
436 JSONFloat -> liftM (A.Number . (fromFloatDigits :: Double -> Scientific))
438 JSONFloat -> liftM (A.Number . (fromFloatDigits :: Double -> Scientific))
437 <$> fromJSVal r
439 <$> fromJSVal r
438 JSONBool -> liftM A.Bool <$> fromJSVal r
440 JSONBool -> liftM A.Bool <$> fromJSVal r
439− JSONString -> liftM (A.String . ("TEST" <>)) <$> fromJSVal r
441+ JSONString -> liftM A.String <$> fromJSVal r
440− -- JSONArray -> liftM (A.Array . V.fromList) <$> (fromJSVal r :: _)
441 JSONArray -> liftM (A.Array . V.fromList) <$>
442 JSONArray -> liftM (A.Array . V.fromList) <$>
442 runMaybeT (traverse (MaybeT . aesonFromJSVal) =<<
443 runMaybeT (traverse (MaybeT . aesonFromJSVal) =<<
443 (MaybeT (fromJSVal r)))
444 (MaybeT (fromJSVal r)))
@@ -447,7 +448,7 @@ aesonFromJSVal r = do
447 propVals <- forM props $ \p -> do
448 propVals <- forM props $ \p -> do
448 v <- MaybeT (aesonFromJSVal =<< OI.getProp p (OI.Object r))
449 v <- MaybeT (aesonFromJSVal =<< OI.getProp p (OI.Object r))
449 return (T.textFromJSString p, v)
450 return (T.textFromJSString p, v)
450− return (A.Object (H.fromList propVals <> H.fromList [("extratest", A.Null)]))
451+ return (A.Object (H.fromList propVals))
451{-# INLINE aesonFromJSVal #-}
452{-# INLINE aesonFromJSVal #-}
@@ -525,11 +526,11 @@ eitherDecodeLenient input =
526-- | `eitherDecode`
527-- | `eitherDecode`
527instance FromJSON a => MimeUnrender JSON a where
528instance FromJSON a => MimeUnrender JSON a where
528− mimeUnrender _ bs =
529+ mimeUnrender _ t =
529#ifdef ghcjs_HOST_OS
530#ifdef ghcjs_HOST_OS
530− note "Raw JSON decode failure" $ rawDecode (BL.toStrict bs)
531+ note "Raw JSON decode failure" $ rawDecode t -- (BL.toStrict bs)
532− eitherDecodeLenient bs
533+ eitherDecodeLenient (BL.fromStrict $ TE.encodeUtf8 t)
535-- -- | @urlDecodeAsForm@
536-- -- | @urlDecodeAsForm@
@@ -540,31 +541,31 @@ instance FromJSON a => MimeUnrender JSON a where
541-- | @left show . TextL.decodeUtf8'@
542-- | @left show . TextL.decodeUtf8'@
542instance MimeUnrender PlainText TextL.Text where
543instance MimeUnrender PlainText TextL.Text where
543− mimeUnrender _ = left show . TextL.decodeUtf8'
544+ mimeUnrender _ = return . TextL.fromStrict
545-- | @left show . TextS.decodeUtf8' . toStrict@
546-- | @left show . TextS.decodeUtf8' . toStrict@
546instance MimeUnrender PlainText T.Text where
547instance MimeUnrender PlainText T.Text where
547− mimeUnrender _ = left show . TE.decodeUtf8' . BL.toStrict
548+ mimeUnrender _ = return
549-- | @Right . BC.unpack@
550-- | @Right . BC.unpack@
550instance MimeUnrender PlainText String where
551instance MimeUnrender PlainText String where
551− mimeUnrender _ = Right . BL.unpack
552+ mimeUnrender _ = Right . T.unpack
553-- | @Right . id@
554-- | @Right . id@
554instance MimeUnrender OctetStream BL.ByteString where
555instance MimeUnrender OctetStream BL.ByteString where
555− mimeUnrender _ = Right . id
556+ mimeUnrender _ = return . TextL.encodeUtf8 . TextL.fromStrict
557-- | @Right . toStrict@
558-- | @Right . toStrict@
558instance MimeUnrender OctetStream BS.ByteString where
559instance MimeUnrender OctetStream BS.ByteString where
559− mimeUnrender _ = Right . BL.toStrict
560+ mimeUnrender _ = Right . TE.encodeUtf8
561class Accept ctype => MimeUnrender ctype a where
562class Accept ctype => MimeUnrender ctype a where
562− mimeUnrender :: Proxy ctype -> BL.ByteString -> Either String a
563+ mimeUnrender :: Proxy ctype -> T.Text -> Either String a
564class AllCTUnrender (list :: [*]) a where
565class AllCTUnrender (list :: [*]) a where
565 handleCTypeH :: Proxy list
566 handleCTypeH :: Proxy list
566 -> BL.ByteString -- Content-Type header
567 -> BL.ByteString -- Content-Type header
567− -> BL.ByteString -- Request body
568+ -> T.Text -- Request body
568 -> Maybe (Either String a)
569 -> Maybe (Either String a)
570instance ( AllMimeUnrender ctyps a ) => AllCTUnrender ctyps a where
571instance ( AllMimeUnrender ctyps a ) => AllCTUnrender ctyps a where
@@ -581,7 +582,7 @@ canHandleAcceptH p (AcceptHeader h ) = isJust $ M.matchAccept (allMime p) h
581--------------------------------------------------------------------------
582--------------------------------------------------------------------------
582class (AllMime list) => AllMimeUnrender (list :: [*]) a where
583class (AllMime list) => AllMimeUnrender (list :: [*]) a where
583 allMimeUnrender :: Proxy list
584 allMimeUnrender :: Proxy list
584− -> BL.ByteString
585+ -> T.Text
585 -> [(M.MediaType, Either String a)]
586 -> [(M.MediaType, Either String a)]
587instance AllMimeUnrender '[] a where
588instance AllMimeUnrender '[] a where