diff --git a/reflex-dom-core/reflex-dom-core.cabal b/reflex-dom-core/reflex-dom-core.cabal index 9d1e2e8..ff6b944 100644 --- a/reflex-dom-core/reflex-dom-core.cabal +++ b/reflex-dom-core/reflex-dom-core.cabal @@ -13,8 +13,6 @@ Cabal-version: >=1.9.2 -- Deal with https://github.com/haskell/cabal/issues/2544 / https://github.com/haskell/cabal/issues/367 extra-source-files: src-ghc/Foreign/JavaScript/Internal/Utils.hs src-ghcjs/Foreign/JavaScript/Internal/Utils.hs - src-ghc/Reflex/Dom/WebSocket/Internal.hs - src-ghcjs/Reflex/Dom/WebSocket/Internal.hs src/Reflex/Dom/Xhr/Foreign.hs src/Reflex/Dom/WebSocket/Foreign.hs src/Reflex/Dom/Xhr/ResponseType.hs @@ -106,7 +104,6 @@ library Reflex.Dom.Specializations Reflex.Dom.Time Reflex.Dom.WebSocket - Reflex.Dom.WebSocket.Internal Reflex.Dom.WebSocket.Query Reflex.Dom.Widget Reflex.Dom.Widget.Basic diff --git a/reflex-dom-core/src-ghc/Reflex/Dom/WebSocket/Internal.hs b/reflex-dom-core/src-ghc/Reflex/Dom/WebSocket/Internal.hs deleted file mode 100644 index b70d04f..0000000 --- a/reflex-dom-core/src-ghc/Reflex/Dom/WebSocket/Internal.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Reflex.Dom.WebSocket.Internal where - -import Data.Aeson -import qualified Data.ByteString.Lazy as LBS -import Data.JSString (JSString) -import Data.JSString.Text -import Data.Text.Encoding - -jsonDecode :: FromJSON a => JSString -> Maybe a -jsonDecode = decode . LBS.fromStrict . encodeUtf8 . textFromJSString diff --git a/reflex-dom-core/src-ghcjs/Reflex/Dom/WebSocket/Internal.hs b/reflex-dom-core/src-ghcjs/Reflex/Dom/WebSocket/Internal.hs deleted file mode 100644 index 46ea566..0000000 --- a/reflex-dom-core/src-ghcjs/Reflex/Dom/WebSocket/Internal.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Reflex.Dom.WebSocket.Internal where - -import Control.Exception -import Data.Aeson -import Data.JSString (JSString) -import Foreign.JavaScript.Utils -import GHCJS.Marshal () -import Language.Javascript.JSaddle -import System.IO.Unsafe - -jsonDecode :: FromJSON a => JSString -> Maybe a -jsonDecode t = do - result <- unsafePerformIO $ handle (\(_ :: SomeException) -> pure Nothing) $ do - safeJsonParse t >>= \case - Nothing -> pure Nothing - Just a -> fromJSVal a - case fromJSON result of - Success a -> pure a - Error _ -> Nothing diff --git a/reflex-dom-core/src/Foreign/JavaScript/Utils.hs b/reflex-dom-core/src/Foreign/JavaScript/Utils.hs index 3b0af22..35b7554 100644 --- a/reflex-dom-core/src/Foreign/JavaScript/Utils.hs +++ b/reflex-dom-core/src/Foreign/JavaScript/Utils.hs @@ -2,20 +2,23 @@ module Foreign.JavaScript.Utils ( bsFromMutableArrayBuffer , bsToArrayBuffer - , jsonParse - , safeJsonParse + , jsonDecode + , js_jsonParse ) where -import Control.Exception +import Control.Exception (SomeException) import Control.Lens +import Data.Aeson import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Foreign.JavaScript.Internal.Utils (js_dataView) import qualified GHCJS.Buffer as JS import GHCJS.DOM.Types (ArrayBuffer (..)) -import qualified Language.Javascript.JSaddle as JS (catch, jsg, js1) +import GHCJS.Marshal () +import Language.Javascript.JSaddle (fromJSVal, catch, jsg, js1) import qualified JavaScript.TypedArray.ArrayBuffer as JS import Language.Javascript.JSaddle.Types (JSString, JSM, JSVal, MonadJSM, ghcjsPure, jsval, liftJSM) +import System.IO.Unsafe {-# INLINABLE bsFromMutableArrayBuffer #-} bsFromMutableArrayBuffer :: MonadJSM m => JS.MutableArrayBuffer -> m ByteString @@ -32,8 +35,12 @@ bsToArrayBuffer bs = liftJSM $ do ref <- ghcjsPure (JS.getArrayBuffer b) >>= ghcjsPure . jsval js_dataView off len ref -safeJsonParse :: JSString -> JSM (Maybe JSVal) -safeJsonParse a = (Just <$> jsonParse a) `JS.catch` \(_ :: SomeException) -> return Nothing +jsonDecode :: FromJSON a => JSString -> Maybe a +jsonDecode t = do + result <- unsafePerformIO $ (fromJSVal =<< js_jsonParse t) `catch` (\(_ :: SomeException) -> pure Nothing) + case fromJSON result of + Success a -> Just a + Error _ -> Nothing -jsonParse :: JSString -> JSM JSVal -jsonParse a = JS.jsg "JSON" ^. JS.js1 "parse" a +js_jsonParse :: JSString -> JSM JSVal +js_jsonParse a = jsg "JSON" ^. js1 "parse" a diff --git a/reflex-dom-core/src/Reflex/Dom/WebSocket.hs b/reflex-dom-core/src/Reflex/Dom/WebSocket.hs index 2f038d4..a55e782 100644 --- a/reflex-dom-core/src/Reflex/Dom/WebSocket.hs +++ b/reflex-dom-core/src/Reflex/Dom/WebSocket.hs @@ -33,7 +33,6 @@ import Prelude hiding (all, concat, concatMap, div, mapM, mapM_, sequence, span) import Reflex.Class import Reflex.Dom.Class import Reflex.Dom.WebSocket.Foreign -import Reflex.Dom.WebSocket.Internal import Reflex.PerformEvent.Class import Reflex.PostBuild.Class import Reflex.TriggerEvent.Class @@ -53,6 +52,7 @@ import Data.JSString.Text import Data.Maybe (isJust) import Data.Text import Data.Text.Encoding +import Foreign.JavaScript.Utils (jsonDecode) import GHCJS.DOM.Types (runJSM, askJSM, MonadJSM, liftJSM, JSM) import GHCJS.Marshal import qualified Language.Javascript.JSaddle.Monad as JS (catch)