git.iko.soy/reflex
on develop help sign in
Use Control.Monad.Ref from the ref-tf package
94ba8c8Benno Fünfstück
default.nix+2−2
compare with develop
unifiedsplit
@@ -1,12 +1,12 @@
1{ mkDerivation, dependent-map, dependent-sum
1{ mkDerivation, dependent-map, dependent-sum
2−, mtl, semigroups, these
2+, mtl, ref-tf, semigroups, these
3}:
3}:
4mkDerivation {
4mkDerivation {
5 pname = "reflex";
5 pname = "reflex";
6 version = "0.1";
6 version = "0.1";
7 src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
7 src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
8 buildDepends = [
8 buildDepends = [
9− dependent-map dependent-sum mtl semigroups these
9+ dependent-map dependent-sum mtl ref-tf semigroups these
10 ];
10 ];
11 license = null;
11 license = null;
12}
12}
reflex.cabal+4−4
@@ -20,11 +20,12 @@ library
20 dependent-sum == 0.2.*,
20 dependent-sum == 0.2.*,
21 dependent-map == 0.1.*,
21 dependent-map == 0.1.*,
22 semigroups == 0.16.*,
22 semigroups == 0.16.*,
23− mtl == 2.2.*,
23+ mtl >= 2.1 && < 2.3,
24 containers == 0.5.*,
24 containers == 0.5.*,
25 these == 0.4.*,
25 these == 0.4.*,
26 primitive == 0.5.*,
26 primitive == 0.5.*,
27− template-haskell >= 2.9 && < 2.11
27+ template-haskell >= 2.9 && < 2.11,
28+ ref-tf == 0.4.*
28
29
29 exposed-modules:
30 exposed-modules:
30 Reflex,
31 Reflex,
@@ -34,8 +35,7 @@ library
34 Reflex.Dynamic,
35 Reflex.Dynamic,
35 Reflex.Dynamic.TH,
36 Reflex.Dynamic.TH,
36 Reflex.Host.Class,
37 Reflex.Host.Class,
37− Data.Functor.Misc,
38+ Data.Functor.Misc
38− Control.Monad.Ref
39
39
40 other-extensions: TemplateHaskell
40 other-extensions: TemplateHaskell
41 ghc-prof-options: -fprof-auto
41 ghc-prof-options: -fprof-auto
src/Control/Monad/Ref.hsdeleted−85
@@ -1,85 +0,0 @@
1−{-# LANGUAGE RecursiveDo, TypeFamilies, LambdaCase #-}
2−module Control.Monad.Ref where
3−
4−import Control.Monad
5−import Control.Monad.Trans
6−import Control.Monad.Reader
7−import Control.Monad.Writer
8−import Data.IORef
9−
10−class Monad m => MonadRef m where
11− type Ref m :: * -> *
12− newRef :: a -> m (Ref m a)
13− readRef :: Ref m a -> m a
14− writeRef :: Ref m a -> a -> m ()
15− atomicModifyRef :: Ref m a -> (a -> (a, b)) -> m b
16−
17−instance MonadRef IO where
18− type Ref IO = IORef
19− {-# INLINE newRef #-}
20− newRef = newIORef
21− {-# INLINE readRef #-}
22− readRef = readIORef
23− {-# INLINE writeRef #-}
24− writeRef = writeIORef
25− {-# INLINE atomicModifyRef #-}
26− atomicModifyRef r f = do
27− result <- atomicModifyIORef' r f
28−-- evaluate =<< readIORef r --TODO: Verify that ghcjs now strictly evaluates the values in atomicModifyIORef', then remove this line
29− return result
30−
31−{-# INLINE cacheM #-}
32−cacheM :: (MonadRef m, MonadRef m', Ref m ~ Ref m') => m' a -> m (m' a, m ())
33−cacheM a = do
34− r <- newRef undefined
35− let invalidate = writeRef r $ do
36− result <- a
37− writeRef r $ return result
38− return result
39− invalidate
40− return (join $ readRef r, invalidate)
41−
42−{-# INLINE cacheMWithTry #-}
43−cacheMWithTry :: (MonadRef m, MonadRef m', Ref m ~ Ref m') => m' a -> m (m' a, m (Maybe a), m ())
44−cacheMWithTry a = do
45− r <- newRef $ Left a
46− let invalidate = writeRef r $ Left a
47− get = readRef r >>= \case
48− Left a' -> do
49− result <- a'
50− writeRef r $ Right result
51− return result
52− Right result -> return result
53− tryGet = readRef r >>= \case
54− Left _ -> return Nothing
55− Right result -> return $ Just result
56− return (get, tryGet, invalidate)
57−
58−-- | Not thread-safe or reentrant
59−{-# INLINE memoM #-}
60−memoM :: (MonadRef m, MonadRef m', Ref m ~ Ref m') => m' a -> m (m' a)
61−memoM = liftM fst . cacheM
62−
63−{-# INLINE replaceRef #-}
64−replaceRef :: MonadRef m => Ref m a -> a -> m a
65−replaceRef r new = atomicModifyRef r $ \old -> (new, old)
66−
67−{-# INLINE modifyRef #-}
68−modifyRef :: MonadRef m => Ref m a -> (a -> a) -> m ()
69−modifyRef r f = atomicModifyRef r $ \a -> (f a, ())
70−
71−instance (Monoid w, MonadRef m) => MonadRef (WriterT w m) where
72− {-# SPECIALIZE instance Monoid w => MonadRef (WriterT w IO) #-}
73− type Ref (WriterT w m) = Ref m
74− newRef = lift . newRef
75− readRef = lift . readRef
76− writeRef r = lift . writeRef r
77− atomicModifyRef r f = lift $ atomicModifyRef r f
78−
79−instance MonadRef m => MonadRef (ReaderT r m) where
80− {-# SPECIALIZE instance MonadRef (ReaderT r IO) #-}
81− type Ref (ReaderT r m) = Ref m
82− newRef = lift . newRef
83− readRef = lift . readRef
84− writeRef r = lift . writeRef r
85− atomicModifyRef r f = lift $ atomicModifyRef r f
src/Reflex/Spider/Internal.hs+7−1
@@ -1282,10 +1282,12 @@ instance MonadRef EventM where
1282 {-# INLINE newRef #-}
1282 {-# INLINE newRef #-}
1283 {-# INLINE readRef #-}
1283 {-# INLINE readRef #-}
1284 {-# INLINE writeRef #-}
1284 {-# INLINE writeRef #-}
1285− {-# INLINE atomicModifyRef #-}
1286 newRef = liftIO . newRef
1285 newRef = liftIO . newRef
1287 readRef = liftIO . readRef
1286 readRef = liftIO . readRef
1288 writeRef r a = liftIO $ writeRef r a
1287 writeRef r a = liftIO $ writeRef r a
1288+
1289+instance MonadAtomicRef EventM where
1290+ {-# INLINE atomicModifyRef #-}
1289 atomicModifyRef r f = liftIO $ atomicModifyRef r f
1291 atomicModifyRef r f = liftIO $ atomicModifyRef r f
1290
1292
1291newtype SpiderHost a = SpiderHost { runSpiderHost :: IO a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO)
1293newtype SpiderHost a = SpiderHost { runSpiderHost :: IO a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO)
@@ -1329,6 +1331,8 @@ instance MonadRef SpiderHost where
1329 newRef = SpiderHost . newRef
1331 newRef = SpiderHost . newRef
1330 readRef = SpiderHost . readRef
1332 readRef = SpiderHost . readRef
1331 writeRef r = SpiderHost . writeRef r
1333 writeRef r = SpiderHost . writeRef r
1334+
1335+instance MonadAtomicRef SpiderHost where
1332 atomicModifyRef r = SpiderHost . atomicModifyRef r
1336 atomicModifyRef r = SpiderHost . atomicModifyRef r
1333
1337
1334instance MonadRef SpiderHostFrame where
1338instance MonadRef SpiderHostFrame where
@@ -1336,4 +1340,6 @@ instance MonadRef SpiderHostFrame where
1336 newRef = SpiderHostFrame . newRef
1340 newRef = SpiderHostFrame . newRef
1337 readRef = SpiderHostFrame . readRef
1341 readRef = SpiderHostFrame . readRef
1338 writeRef r = SpiderHostFrame . writeRef r
1342 writeRef r = SpiderHostFrame . writeRef r
1343+
1344+instance MonadAtomicRef SpiderHostFrame where
1339 atomicModifyRef r = SpiderHostFrame . atomicModifyRef r
1345 atomicModifyRef r = SpiderHostFrame . atomicModifyRef r