git.iko.soy/jsaddle
on master help sign in
Add nicer way to enableLogging
bb3b041Hamish Mackenzie
jsaddle/src/Language/Javascript/JSaddle/Run.hs+12−1
compare with master
unifiedsplit
@@ -19,6 +19,7 @@ module Language.Javascript.JSaddle.Run (
19 , syncAfter
19 , syncAfter
20 , waitForAnimationFrame
20 , waitForAnimationFrame
21 , nextAnimationFrame
21 , nextAnimationFrame
22+ , enableLogging
22#ifndef ghcjs_HOST_OS
23#ifndef ghcjs_HOST_OS
23 -- * Functions used to implement JSaddle using JSON messaging
24 -- * Functions used to implement JSaddle using JSON messaging
24 , runJavaScript
25 , runJavaScript
@@ -68,6 +69,16 @@ import Control.DeepSeq (deepseq)
68import GHC.Stats (getGCStatsEnabled, getGCStats, GCStats(..))
69import GHC.Stats (getGCStatsEnabled, getGCStats, GCStats(..))
69#endif
70#endif
70
71
72+-- | Enable (or disable) JSaddle logging
73+enableLogging :: Bool -> JSM ()
74+#ifdef ghcjs_HOST_OS
75+enableLogging _ = return ()
76+#else
77+enableLogging v = do
78+ f <- doEnableLogging <$> JSM ask
79+ liftIO $ f v
80+#endif
81+
71-- | Forces execution of pending asyncronous code
82-- | Forces execution of pending asyncronous code
72syncPoint :: JSM ()
83syncPoint :: JSM ()
73#ifdef ghcjs_HOST_OS
84#ifdef ghcjs_HOST_OS
@@ -156,7 +167,7 @@ runJavaScript sendBatch entryPoint = do
156 , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar' callbacks (M.insert val cb)
167 , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar' callbacks (M.insert val cb)
157 , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar' callbacks (M.delete val)
168 , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar' callbacks (M.delete val)
158 , nextRef = nextRef'
169 , nextRef = nextRef'
159− , enableLogging = atomicWriteIORef loggingEnabled
170+ , doEnableLogging = atomicWriteIORef loggingEnabled
160 }
171 }
161 let processResults = \case
172 let processResults = \case
162 (ProtocolError err) -> error $ "Protocol error : " <> T.unpack err
173 (ProtocolError err) -> error $ "Protocol error : " <> T.unpack err
jsaddle/src/Language/Javascript/JSaddle/Types.hs+1−1
@@ -114,7 +114,7 @@ data JSContextRef = JSContextRef {
114 , addCallback :: Object -> JSCallAsFunction -> IO ()
114 , addCallback :: Object -> JSCallAsFunction -> IO ()
115 , freeCallback :: Object -> IO ()
115 , freeCallback :: Object -> IO ()
116 , nextRef :: TVar JSValueRef
116 , nextRef :: TVar JSValueRef
117− , enableLogging :: Bool -> IO ()
117+ , doEnableLogging :: Bool -> IO ()
118}
118}
119#endif
119#endif
120
120