{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE RecordWildCards #-}
-- | External reference with reactivity support. The reference is needed in glue
-- code between reflex and external libs where you cannot sample from dynamics
-- with `MonadSample`.
module Reflex.ExternalRef(
ExternalRef(..)
, newExternalRef
, readExternalRef
, writeExternalRef
, modifyExternalRef
, modifyExternalRef_
, modifyExternalRefMaybe
, modifyExternalRefMaybe_
, modifyExternalRefM
, modifyExternalRefM_
, modifyExternalRefMaybeM
, modifyExternalRefMaybeM_
, externalRefBehavior
, externalRefDynamic
, externalFromDynamic
, fmapExternalRef
) where
import Control.DeepSeq
import Control.Monad.IO.Class
import Data.IORef
import GHC.Generics
import Reflex
-- | Holds value of type `a` and provides ways for notifying FRP network about
-- changes of the variable.
--
-- This abstraction is helpful for storing counters, lists of internal resources
-- and so on. It is designed to be updated from outputs of FRP network, not from
-- outer world.
data ExternalRef t a = ExternalRef {
-- | Storage of value (do not change this by yourself, use helpers)
externalRef :: !(IORef a)
-- | Event that fires when value is changed
, externalEvent :: !(Event t a)
-- | Method of updating value of previous event
, externalFire :: !(a -> IO ())
} deriving (Generic)
instance NFData (ExternalRef t a) where
rnf ExternalRef{..} =
externalRef `deepseq`
externalEvent `seq`
externalFire `seq`
()
-- | Creation of external ref in host monad
newExternalRef :: (MonadIO m, TriggerEvent t m) => a -> m (ExternalRef t a)
newExternalRef a = do
ref <- liftIO $ newIORef a
(e, fire) <- newTriggerEvent
return $ ExternalRef ref e fire
-- | Read current value of external reference
readExternalRef :: MonadIO m => ExternalRef t a -> m a
readExternalRef ExternalRef {..} = liftIO $ readIORef externalRef
-- | Write new value to external reference and notify FRP network.
-- The function evaluates the value to WNF.
writeExternalRef :: MonadIO m => ExternalRef t a -> a -> m ()
writeExternalRef ExternalRef {..} a = do
a `seq` liftIO (writeIORef externalRef a)
_ <- liftIO $ externalFire a
return ()
-- | Atomically modify an external ref and notify FRP network.
-- The function evaluates the value to WNF.
modifyExternalRef :: MonadIO m => ExternalRef t a -> (a -> (a, b)) -> m b
modifyExternalRef ExternalRef {..} f = do
(a, b) <- liftIO $ atomicModifyIORef' externalRef $ \a ->
let (a', b) = f a in (a', (a', b))
_ <- liftIO $ externalFire a
return b
-- | Atomically modify an external ref and notify FRP network.
-- The function evaluates the value to WNF. Returns nothing
modifyExternalRef_ :: MonadIO m => ExternalRef t a -> (a -> a) -> m ()
modifyExternalRef_ ExternalRef {..} f = do
a <- liftIO $ atomicModifyIORef' externalRef $ \a ->
let a' = f a in (a', a')
liftIO $ externalFire a
-- | If the function evaluates to Just then
-- Atomically modify an external ref and notify FRP network.
-- The function evaluates the value to WNF.
-- Return the Maybe result of function's evaluation
modifyExternalRefMaybe :: MonadIO m => ExternalRef t a -> (a -> Maybe (a,b)) -> m (Maybe b)
modifyExternalRefMaybe ExternalRef {..} f = do
mab <- liftIO $ atomicModifyIORef' externalRef $ \a ->
maybe (a, Nothing) (\ab-> (fst ab, Just ab)) $ f a
liftIO $ maybe (pure ()) (externalFire . fst) mab
pure $ snd <$> mab
-- | If the function evaluates to Just then
-- Atomically modify an external ref and notify FRP network.
-- The function evaluates the value to WNF. Returns nothing
-- The function discards the result
modifyExternalRefMaybe_ :: MonadIO m => ExternalRef t a -> (a -> Maybe a) -> m ()
modifyExternalRefMaybe_ ExternalRef {..} f = do
ma <- liftIO $ atomicModifyIORef' externalRef $ \a ->
maybe (a, Nothing) (\a' -> (a', Just a')) $ f a
liftIO $ maybe (pure ()) externalFire ma
-- | Modify (not atomically) an external ref and notify FRP network.
-- The function evaluates the value to WNF.
modifyExternalRefM :: MonadIO m => ExternalRef t a -> (a -> m (a, b)) -> m b
modifyExternalRefM ExternalRef {..} f = do
a <- liftIO $ readIORef externalRef
(a', b) <- f a
liftIO $ do
writeIORef externalRef a'
externalFire a'
return b
-- | Modify (not atomically) an external ref and notify FRP network.
-- The function evaluates the value to WNF.
modifyExternalRefM_ :: MonadIO m => ExternalRef t a -> (a -> m a) -> m ()
modifyExternalRefM_ ExternalRef {..} f = do
a <- liftIO $ readIORef externalRef
a' <- f a
liftIO $ do
writeIORef externalRef a'
externalFire a'
-- | If the function evaluates to Just then
-- Modify (not atomically) an external ref and notify FRP network.
-- The function evaluates the value to WNF.
modifyExternalRefMaybeM :: MonadIO m => ExternalRef t a -> (a -> m (Maybe (a, b))) -> m (Maybe b)
modifyExternalRefMaybeM ExternalRef {..} f = do
a <- liftIO $ readIORef externalRef
mab <- f a
case mab of
Nothing -> pure Nothing
Just (a',b) -> liftIO $ do
writeIORef externalRef a'
externalFire a'
return $ Just b
-- | If the function evaluates to Just then
-- Modify (not atomically) an external ref and notify FRP network.
-- The function evaluates the value to WNF.
-- The function discards the result
modifyExternalRefMaybeM_ :: MonadIO m => ExternalRef t a -> (a -> m (Maybe a)) -> m ()
modifyExternalRefMaybeM_ ExternalRef {..} f = do
a <- liftIO $ readIORef externalRef
ma <- f a
case ma of
Nothing -> pure ()
Just a' -> liftIO $ do
writeIORef externalRef a'
externalFire a'
-- | Construct a behavior from external reference
externalRefBehavior :: (MonadHold t m, MonadIO m) => ExternalRef t a -> m (Behavior t a)
externalRefBehavior ExternalRef {..} = do
a <- liftIO $ readIORef externalRef
hold a externalEvent
-- | Get dynamic that tracks value of the internal ref
externalRefDynamic :: (MonadHold t m, MonadIO m) => ExternalRef t a -> m (Dynamic t a)
externalRefDynamic ExternalRef {..} = do
a <- liftIO $ readIORef externalRef
holdDyn a externalEvent
-- | Create external ref that tracks content of dynamic. Editing of the ref
-- has no effect on the original dynamic.
externalFromDynamic :: (MonadHold t m, TriggerEvent t m, PerformEvent t m, Reflex t, MonadIO m, MonadIO (Performable m))
=> Dynamic t a -> m (ExternalRef t a)
externalFromDynamic da = do
a0 <- sample . current $ da
r <- newExternalRef a0
performEvent_ $ fmap (writeExternalRef r) $ updated da
pure r
-- | Creates external ref as a result of "fmapping" a function to the original ref.
-- ExternalRef t is not a true Functior, since it requres monadic action to "fmap"
-- Editing of the new ref has no effect on the original dynamic.
fmapExternalRef :: (MonadIO m, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))
=> (a -> b) -> ExternalRef t a -> m (ExternalRef t b)
fmapExternalRef f ea = do
v0 <- readExternalRef ea
r <- newExternalRef $ f v0
performEvent_ $ fmap (writeExternalRef r . f) $ externalEvent ea
pure r