bbf9a05 · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

abstract debug prints from putStrLn

bbf9a05James Deikun7 years ago

src/Reflex/Spider/Internal.hs+23−9

compare with develop

unifiedsplit

@@ -114,7 +114,13 @@ import Reflex.PerformEvent.Base (PerformEventT)

114import qualified Data.ByteString.Char8 as BS8

115import System.IO (stderr)

116import Data.List (isPrefixOf)

117+#endif

118+

119+-- TODO stdout might not be the best channel for debug output

120+debugStrLn :: String -> IO ()

121+debugStrLn = putStrLn

117

122

123+#ifdef DEBUG_TRACE_EVENTS

118withStackOneLine :: (BS8.ByteString -> a) -> a

124withStackOneLine :: (BS8.ByteString -> a) -> a

119withStackOneLine expr = unsafePerformIO $ do

125withStackOneLine expr = unsafePerformIO $ do

120 stack <- currentCallStack

126 stack <- currentCallStack

@@ -1299,7 +1305,7 @@ mkWeakPtrWithDebug x debugNote = do

1299 x' <- evaluate x

1305 x' <- evaluate x

1300 mkWeakPtr x' $

1306 mkWeakPtr x' $

1301 if debugFinalize

1307 if debugFinalize

1302− then Just $ putStrLn $ "finalizing: " ++ debugNote

1308+ then Just $ debugStrLn $ "finalizing: " ++ debugNote

1303 else Nothing

1309 else Nothing

1304

1310

1305type WeakList a = [Weak a]

1311type WeakList a = [Weak a]

@@ -1321,13 +1327,13 @@ debugSubscriber' description subscribed = Subscriber

1321 tracePropagate (Proxy :: Proxy x) ("subscriberPropagate: " <> description)

1327 tracePropagate (Proxy :: Proxy x) ("subscriberPropagate: " <> description)

1322 subscriberPropagate subscribed m

1328 subscriberPropagate subscribed m

1323 , subscriberInvalidateHeight = \old -> do

1329 , subscriberInvalidateHeight = \old -> do

1324− putStrLn $ "invalidateSubscriberHeight: " <> description <> ", old = " <> show (unHeight old)

1330+ traceInvalidateHeight $ "invalidateSubscriberHeight: " <> description <> ", old = " <> show (unHeight old)

1325 subscriberInvalidateHeight subscribed old

1331 subscriberInvalidateHeight subscribed old

1326− putStrLn $ "invalidateSubscriberHeight: " <> description <> ", done"

1332+ traceInvalidateHeight $ "invalidateSubscriberHeight: " <> description <> ", done"

1327 , subscriberRecalculateHeight = \new -> do

1333 , subscriberRecalculateHeight = \new -> do

1328− putStrLn $ "subscriberRecalculateHeight: " <> description <> ", new = " <> show (unHeight new)

1334+ traceInvalidateHeight $ "subscriberRecalculateHeight: " <> description <> ", new = " <> show (unHeight new)

1329 subscriberRecalculateHeight subscribed new

1335 subscriberRecalculateHeight subscribed new

1330− putStrLn $ "subscriberRecalculateHeight: " <> description <> ", done"

1336+ traceInvalidateHeight $ "subscriberRecalculateHeight: " <> description <> ", done"

1331 }

1337 }

1332

1338

1333

1339

@@ -1341,11 +1347,15 @@ withIncreasedDepth _ a = do

1341

1347

1342{-# INLINE tracePropagate #-}

1348{-# INLINE tracePropagate #-}

1343tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()

1349tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()

1344−tracePropagate p = trace p

1350+tracePropagate p = when debugPropagate . trace p

1345

1351

1346{-# INLINE traceInvalidate #-}

1352{-# INLINE traceInvalidate #-}

1347traceInvalidate :: String -> IO ()

1353traceInvalidate :: String -> IO ()

1348−traceInvalidate = liftIO . putStrLn

1354+traceInvalidate = liftIO . debugStrLn

1355+

1356+{-# INLINE traceInvalidateHeight #-}

1357+traceInvalidateHeight :: String -> IO ()

1358+traceInvalidateHeight = liftIO . debugStrLn

1349

1359

1350{-# INLINE trace #-}

1360{-# INLINE trace #-}

1351trace :: (CanTrace x m) => proxy x -> String -> m ()

1361trace :: (CanTrace x m) => proxy x -> String -> m ()

@@ -1356,7 +1366,7 @@ traceM :: forall x proxy m. (CanTrace x m) => proxy x -> m String -> m ()

1356traceM _ getMessage = do

1366traceM _ getMessage = do

1357 message <- getMessage

1367 message <- getMessage

1358 d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)

1368 d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE (spiderTimeline :: SpiderTimelineEnv x)

1359− liftIO $ putStrLn $ replicate d ' ' <> message

1369+ liftIO $ debugStrLn $ replicate d ' ' <> message

1360

1370

1361#else

1371#else

1362

1372

@@ -1372,6 +1382,10 @@ tracePropagate _ _ = return ()

1372traceInvalidate :: String -> IO ()

1382traceInvalidate :: String -> IO ()

1373traceInvalidate _ = return ()

1383traceInvalidate _ = return ()

1374

1384

1385+{-# INLINE traceInvalidateHeight #-}

1386+traceInvalidateHeight :: String -> IO ()

1387+traceInvalidateHeight _ = return ()

1388+

1375{-# INLINE debugSubscriber #-}

1389{-# INLINE debugSubscriber #-}

1376debugSubscriber :: String -> Subscriber x a -> IO (Subscriber x a)

1390debugSubscriber :: String -> Subscriber x a -> IO (Subscriber x a)

1377debugSubscriber _ = return

1391debugSubscriber _ = return

@@ -2327,7 +2341,7 @@ runFrame a = SpiderHost $ do

2327 subscription <- unSpiderHost $ runFrame $ {-# SCC "subscribeSwitch" #-} subscribe e sub --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient

2341 subscription <- unSpiderHost $ runFrame $ {-# SCC "subscribeSwitch" #-} subscribe e sub --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient

2328 {-

2342 {-

2329 stackTrace <- liftIO $ fmap renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)

2343 stackTrace <- liftIO $ fmap renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)

2330− liftIO $ putStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of

2344+ liftIO $ debugStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of

2331 EventRoot _ -> "EventRoot"

2345 EventRoot _ -> "EventRoot"

2332 EventNever -> "EventNever"

2346 EventNever -> "EventNever"

2333 _ -> "something else"

2347 _ -> "something else"