git.iko.soy/reflex-dom
on develop help sign in
Drop ghcjs-json and move jsonDecode to utils
commit18d6776cd675d175b21642192de978a112638637 authorLuigy Leon <luigy@outlook.com> dateMon 5 Feb 2018, 20:03 (9 years ago) parentc8ed74c
5 files changed+16−44
compare with develop
unifiedsplit
reflex-dom-core/reflex-dom-core.cabal−3 reflex-dom-core/src-ghc/Reflex/Dom/WebSocket/Internal.hs−10 reflex-dom-core/src-ghcjs/Reflex/Dom/WebSocket/Internal.hs−22 reflex-dom-core/src/Foreign/JavaScript/Utils.hs+15−8 reflex-dom-core/src/Reflex/Dom/WebSocket.hs+1−1
reflex-dom-core/reflex-dom-core.cabal−3
@@ -13,8 +13,6 @@ Cabal-version: >=1.9.2
1313-- Deal with https://github.com/haskell/cabal/issues/2544 / https://github.com/haskell/cabal/issues/367
1414extra-source-files: src-ghc/Foreign/JavaScript/Internal/Utils.hs
1515 src-ghcjs/Foreign/JavaScript/Internal/Utils.hs
16− src-ghc/Reflex/Dom/WebSocket/Internal.hs
17− src-ghcjs/Reflex/Dom/WebSocket/Internal.hs
1816 src/Reflex/Dom/Xhr/Foreign.hs
1917 src/Reflex/Dom/WebSocket/Foreign.hs
2018 src/Reflex/Dom/Xhr/ResponseType.hs
@@ -106,7 +104,6 @@ library
106104 Reflex.Dom.Specializations
107105 Reflex.Dom.Time
108106 Reflex.Dom.WebSocket
109− Reflex.Dom.WebSocket.Internal
110107 Reflex.Dom.WebSocket.Query
111108 Reflex.Dom.Widget
112109 Reflex.Dom.Widget.Basic
reflex-dom-core/src-ghc/Reflex/Dom/WebSocket/Internal.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Reflex.Dom.WebSocket.Internal where
2−
3−import Data.Aeson
4−import qualified Data.ByteString.Lazy as LBS
5−import Data.JSString (JSString)
6−import Data.JSString.Text
7−import Data.Text.Encoding
8−
9−jsonDecode :: FromJSON a => JSString -> Maybe a
10−jsonDecode = decode . LBS.fromStrict . encodeUtf8 . textFromJSString
reflex-dom-core/src-ghcjs/Reflex/Dom/WebSocket/Internal.hsdeleted−22
@@ -1,22 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE LambdaCase #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−module Reflex.Dom.WebSocket.Internal where
5−
6−import Control.Exception
7−import Data.Aeson
8−import Data.JSString (JSString)
9−import Foreign.JavaScript.Utils
10−import GHCJS.Marshal ()
11−import Language.Javascript.JSaddle
12−import System.IO.Unsafe
13−
14−jsonDecode :: FromJSON a => JSString -> Maybe a
15−jsonDecode t = do
16− result <- unsafePerformIO $ handle (\(_ :: SomeException) -> pure Nothing) $ do
17− safeJsonParse t >>= \case
18− Nothing -> pure Nothing
19− Just a -> fromJSVal a
20− case fromJSON result of
21− Success a -> pure a
22− Error _ -> Nothing
reflex-dom-core/src/Foreign/JavaScript/Utils.hs+15−8
@@ -2,20 +2,23 @@
22module Foreign.JavaScript.Utils
33 ( bsFromMutableArrayBuffer
44 , bsToArrayBuffer
5− , jsonParse
6− , safeJsonParse
5+ , jsonDecode
6+ , js_jsonParse
77 ) where
88
9−import Control.Exception
9+import Control.Exception (SomeException)
1010import Control.Lens
11+import Data.Aeson
1112import Data.ByteString (ByteString)
1213import qualified Data.ByteString as BS
1314import Foreign.JavaScript.Internal.Utils (js_dataView)
1415import qualified GHCJS.Buffer as JS
1516import GHCJS.DOM.Types (ArrayBuffer (..))
16−import qualified Language.Javascript.JSaddle as JS (catch, jsg, js1)
17+import GHCJS.Marshal ()
18+import Language.Javascript.JSaddle (fromJSVal, catch, jsg, js1)
1719import qualified JavaScript.TypedArray.ArrayBuffer as JS
1820import Language.Javascript.JSaddle.Types (JSString, JSM, JSVal, MonadJSM, ghcjsPure, jsval, liftJSM)
21+import System.IO.Unsafe
1922
2023{-# INLINABLE bsFromMutableArrayBuffer #-}
2124bsFromMutableArrayBuffer :: MonadJSM m => JS.MutableArrayBuffer -> m ByteString
@@ -32,8 +35,12 @@ bsToArrayBuffer bs = liftJSM $ do
3235 ref <- ghcjsPure (JS.getArrayBuffer b) >>= ghcjsPure . jsval
3336 js_dataView off len ref
3437
35−safeJsonParse :: JSString -> JSM (Maybe JSVal)
36−safeJsonParse a = (Just <$> jsonParse a) `JS.catch` \(_ :: SomeException) -> return Nothing
38+jsonDecode :: FromJSON a => JSString -> Maybe a
39+jsonDecode t = do
40+ result <- unsafePerformIO $ (fromJSVal =<< js_jsonParse t) `catch` (\(_ :: SomeException) -> pure Nothing)
41+ case fromJSON result of
42+ Success a -> Just a
43+ Error _ -> Nothing
3744
38−jsonParse :: JSString -> JSM JSVal
39−jsonParse a = JS.jsg "JSON" ^. JS.js1 "parse" a
45+js_jsonParse :: JSString -> JSM JSVal
46+js_jsonParse a = jsg "JSON" ^. js1 "parse" a
reflex-dom-core/src/Reflex/Dom/WebSocket.hs+1−1
@@ -33,7 +33,6 @@ import Prelude hiding (all, concat, concatMap, div, mapM, mapM_, sequence, span)
3333import Reflex.Class
3434import Reflex.Dom.Class
3535import Reflex.Dom.WebSocket.Foreign
36−import Reflex.Dom.WebSocket.Internal
3736import Reflex.PerformEvent.Class
3837import Reflex.PostBuild.Class
3938import Reflex.TriggerEvent.Class
@@ -53,6 +52,7 @@ import Data.JSString.Text
5352import Data.Maybe (isJust)
5453import Data.Text
5554import Data.Text.Encoding
55+import Foreign.JavaScript.Utils (jsonDecode)
5656import GHCJS.DOM.Types (runJSM, askJSM, MonadJSM, liftJSM, JSM)
5757import GHCJS.Marshal
5858import qualified Language.Javascript.JSaddle.Monad as JS (catch)