@@ -1,6 +1,15 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE FlexibleContexts #-}
33
4+#ifdef __HADDOCK_VERSION__
5+#undef INSPECTION
6+#endif
7+
8+#ifdef INSPECTION
9+{-# LANGUAGE TemplateHaskell #-}
10+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
11+#endif
12+
413-- |
514-- Module : Streamly.Internal.Data.Stream.SVar
615-- Copyright : (c) 2017 Harendra Kumar
@@ -33,10 +42,18 @@ import System.Mem (performMajorGC)
3342import Streamly.Internal.Data.SVar
3443import Streamly.Internal.Data.Stream.StreamK hiding (reverse)
3544
45+#ifdef INSPECTION
46+import Control.Exception (Exception)
47+import Control.Monad.Catch (MonadThrow)
48+import Control.Monad.Trans.Control (MonadBaseControl)
49+import Data.Typeable (Typeable)
50+import Test.Inspection (inspect, hasNoTypeClassesExcept)
51+#endif
52+
3653-- | Pull a stream from an SVar.
3754{-# NOINLINE fromStreamVar #-}
3855fromStreamVar :: MonadAsync m => SVar Stream m a -> Stream m a
39−fromStreamVar sv = mkStream $ \st yld sng stp -> do
56+fromStreamVar sv = MkStream $ \st yld sng stp -> do
4057 list <- readOutputQ sv
4158 -- Reversing the output is important to guarantee that we process the
4259 -- outputs in the same order as they were generated by the constituent
@@ -53,13 +70,13 @@ fromStreamVar sv = mkStream $ \st yld sng stp -> do
5370 stp
5471
5572 {-# INLINE processEvents #-}
56− processEvents [] = mkStream $ \st yld sng stp -> do
73+ processEvents [] = MkStream $ \st yld sng stp -> do
5774 done <- postProcess sv
5875 if done
5976 then allDone stp
6077 else foldStream st yld sng stp $ fromStreamVar sv
6178
62− processEvents (ev : es) = mkStream $ \st yld sng stp -> do
79+ processEvents (ev : es) = MkStream $ \st yld sng stp -> do
6380 let rest = processEvents es
6481 case ev of
6582 ChildYield a -> yld a rest
@@ -84,6 +101,23 @@ fromStreamVar sv = mkStream $ \st yld sng stp -> do
84101 sid <- liftIO $ readIORef (svarStopBy sv)
85102 return $ if tid == sid then True else False
86103
104+#ifdef INSPECTION
105+-- Use of GHC constraint tuple (GHC.Classes.(%,,%)) in fromStreamVar leads to
106+-- space leak because the tuple gets allocated in every recursive call and each
107+-- allocation holds on to the previous allocation. This test is to make sure
108+-- that we do not use the constraint tuple type class.
109+--
110+inspect $ hasNoTypeClassesExcept 'fromStreamVar
111+ [ ''Monad
112+ , ''Applicative
113+ , ''MonadThrow
114+ , ''Exception
115+ , ''MonadIO
116+ , ''MonadBaseControl
117+ , ''Typeable
118+ ]
119+#endif
120+
87121{-# INLINE fromSVar #-}
88122fromSVar :: (MonadAsync m, IsStream t) => SVar Stream m a -> t m a
89123fromSVar sv =