git.iko.soy/streamly
on master help sign in
Move the user state related stuff out of Context.hs
commit467a3015425e0832db431f945a68c9d9a40b3d36 authorHarendra Kumar <harendra.kumar@gmail.com> dateMon 26 Jun 2017, 03:27 (9 years ago) parent594185f
2 files changed+45−46
compare with master
unifiedsplit
src/Strands/Context.hs+4−44 src/Strands/State.hs+41−2
src/Strands/Context.hs+4−44
@@ -15,22 +15,16 @@ module Strands.Context
1515 , Location(..)
1616 , getLocation
1717 , setLocation
18− , getData
19− , setData
20− , modifyData
21− , delData
2218 )
2319where
2420
2521import Control.Concurrent (ThreadId)
2622import Control.Concurrent.STM (TChan)
2723import Control.Exception (SomeException)
28−import Control.Monad.State (MonadState, gets, modify, StateT,
29− MonadPlus(..), MonadIO(..))
24+import Control.Monad.State (StateT, MonadPlus(..), MonadIO(..))
3025import qualified Control.Monad.Trans.State.Lazy as Lazy (get, gets, modify, put)
31−import Data.Dynamic (TypeRep, Typeable, typeOf)
26+import Data.Dynamic (Typeable)
3227import Data.IORef (IORef)
33−import qualified Data.Map as M
3428import Data.Maybe (fromJust)
3529import Unsafe.Coerce (unsafeCoerce)
3630import GHC.Prim (Any)
@@ -72,7 +66,7 @@ data Context = Context
7266 -- User state
7367 ---------------------------------------------------------------------------
7468
75− , mfData :: M.Map TypeRep Any -- untyped, type coerced
69+ -- , mfData :: M.Map TypeRep Any -- untyped, type coerced
7670 -- ^ State data accessed with get or put operations
7771
7872 ---------------------------------------------------------------------------
@@ -141,7 +135,7 @@ initContext x childChan pending credit finalizer results =
141135 , currentm = unsafeCoerce x
142136 , fstack = [unsafeCoerce finalizer]
143137 , location = Worker
144− , mfData = mempty
138+ -- , mfData = mempty
145139 , parentChannel = Nothing
146140 , childChannel = unsafeCoerce childChan
147141 , pendingThreads = pending
@@ -240,37 +234,3 @@ getCtxResultDest :: Context -> Either (TChan (ChildEvent a)) (IORef [a])
240234getCtxResultDest ctx =
241235 maybe (Right $ unsafeCoerce $ fromJust $ accumResults ctx)
242236 (Left . unsafeCoerce) (parentChannel ctx)
243−
244−------------------------------------------------------------------------------
245−-- * Extensible State: Session Data Management
246−------------------------------------------------------------------------------
247−
248−-- | Same as 'getSData' but with a more general type. If the data is found, a
249−-- 'Just' value is returned. Otherwise, a 'Nothing' value is returned.
250−getData :: (MonadState Context m, Typeable a) => m (Maybe a)
251−getData = resp
252− where resp = do
253− list <- gets mfData
254− case M.lookup (typeOf $ typeResp resp) list of
255− Just x -> return . Just $ unsafeCoerce x
256− Nothing -> return Nothing
257− typeResp :: m (Maybe x) -> x
258− typeResp = undefined
259−
260−-- | Same as 'setSData' but with a more general type.
261−setData :: (MonadState Context m, Typeable a) => a -> m ()
262−setData x = modify $ \st -> st { mfData = M.insert t (unsafeCoerce x) (mfData st) }
263− where t = typeOf x
264−
265−modifyData :: (MonadState Context m, Typeable a) => (Maybe a -> Maybe a) -> m ()
266−modifyData f = modify $ \st -> st { mfData = M.alter alterf t (mfData st) }
267− where typeResp :: (Maybe a -> b) -> a
268− typeResp = undefined
269− t = typeOf (typeResp f)
270− alterf mx = unsafeCoerce $ f x'
271− where x' = case mx of
272− Just x -> Just $ unsafeCoerce x
273− Nothing -> Nothing
274−
275−delData :: (MonadState Context m, Typeable a) => a -> m ()
276−delData x = modify $ \st -> st { mfData = M.delete (typeOf x) (mfData st) }
src/Strands/State.hs+41−2
@@ -11,6 +11,10 @@
1111
1212module Strands.State
1313 (
14+ getData
15+ , setData
16+ , modifyData
17+ , delData
1418 )
1519where
1620
@@ -19,13 +23,14 @@ import Control.Monad.Base (MonadBase (..), liftBaseDefault)
1923import Control.Monad.Catch (MonadThrow, throwM)
2024import Control.Monad.State (MonadIO (..), MonadPlus (..),
2125 MonadState (..), StateT (..),
22− liftM, modify, runStateT, when)
26+ liftM, gets, modify, runStateT, when)
2327import Control.Monad.Trans.Class (MonadTrans (lift))
2428import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..),
2529 MonadTransControl (..),
2630 defaultLiftBaseWith,
2731 defaultRestoreM)
28−import Data.Dynamic (Typeable)
32+import Data.Dynamic (TypeRep, Typeable, typeOf)
33+import qualified Data.Map as M
2934
3035import Strands.Context
3136
@@ -33,6 +38,40 @@ import Strands.Context
3338-- * Extensible State: Session Data Management
3439------------------------------------------------------------------------------
3540
41+-- | Same as 'getSData' but with a more general type. If the data is found, a
42+-- 'Just' value is returned. Otherwise, a 'Nothing' value is returned.
43+getData :: (MonadState Context m, Typeable a) => m (Maybe a)
44+getData = resp
45+ where resp = do
46+ list <- gets mfData
47+ case M.lookup (typeOf $ typeResp resp) list of
48+ Just x -> return . Just $ unsafeCoerce x
49+ Nothing -> return Nothing
50+ typeResp :: m (Maybe x) -> x
51+ typeResp = undefined
52+
53+-- | Same as 'setSData' but with a more general type.
54+setData :: (MonadState Context m, Typeable a) => a -> m ()
55+setData x = modify $ \st -> st { mfData = M.insert t (unsafeCoerce x) (mfData st) }
56+ where t = typeOf x
57+
58+modifyData :: (MonadState Context m, Typeable a) => (Maybe a -> Maybe a) -> m ()
59+modifyData f = modify $ \st -> st { mfData = M.alter alterf t (mfData st) }
60+ where typeResp :: (Maybe a -> b) -> a
61+ typeResp = undefined
62+ t = typeOf (typeResp f)
63+ alterf mx = unsafeCoerce $ f x'
64+ where x' = case mx of
65+ Just x -> Just $ unsafeCoerce x
66+ Nothing -> Nothing
67+
68+delData :: (MonadState Context m, Typeable a) => a -> m ()
69+delData x = modify $ \st -> st { mfData = M.delete (typeOf x) (mfData st) }
70+
71+------------------------------------------------------------------------------
72+-- * Extensible State: Session Data Management
73+------------------------------------------------------------------------------
74+
3675-- | Retrieve a previously stored data item of the given data type from the
3776-- monad state. The data type to retrieve is implicitly determined from the
3877-- requested type context.