Drop ghcjs-json and move jsonDecode to utils

This commit is contained in:
Luigy Leon 2018-02-05 20:03:21 -05:00
parent c8ed74cc8b
commit 18d6776cd6
5 changed files with 16 additions and 44 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)