|
module SharedState where |
|
import Concur.Core |
|
import Concur.Replica |
|
import Control.Monad |
|
import Control.Applicative |
|
import Control.Concurrent.STM |
|
import Control.Concurrent.STM.TVar |
|
import Control.Concurrent.STM.TChan |
|
import Control.Lens |
|
import Control.Monad.IO.Class (liftIO) |
|
|
|
data Δ a = Value (TVar a) (TChan a) deriving Eq |
|
|
|
|
|
local :: a -> (Δ a -> Widget HTML b) -> Widget HTML b |
|
local a f = do |
|
v <- liftSTM $ liftA2 Value (newTVar a) newBroadcastTChan |
|
f v |
|
|
|
with :: Δ a -> (a -> Widget HTML (Either a r)) -> Widget HTML r |
|
with (Value ref bcast) w = do |
|
(a, read) <- liftSTM $ liftA2 (,) (readTVar ref) (dupTChan bcast) |
|
go read a |
|
where |
|
go read a = do |
|
r <- fmap Left (w a) <|> fmap Right (get read) |
|
case r of |
|
Right a' -> go read a' |
|
Left (Left a') -> do |
|
write read a' |
|
go read a' |
|
Left (Right b) -> pure b |
|
|
|
get read = liftSTM $ readTChan read |
|
|
|
write read a = liftSTM $ do |
|
writeTVar ref a |
|
writeTChan bcast a |
|
readTChan read -- don't react to the value we just wrote |
|
|
|
-- look lens-action |
|
-- mapValue :: Lens s t -> Δ s -> Δ t |
|
-- mapValue tlens (Value ref bcast) = unsafePerformIO $ do |
|
-- (a, read) <- atomically $ liftA2 (,) (readTVar ref) (dupTChan bcast) |
|
-- atomically $ liftA2 Value (newTVar (tlens a)) newBroadcastTChan -- data diverges here. Try Value (f TVar a) tlens (f (Chan a))...couldn't be a hetero functor.... |
|
|
|
-- filtered broadcastTChan |
|
-- the big TVar should always be changed after small ones (like or). Vice not versa. (like filter/ prepdicate) |
|
-- |
|
-- pair needs extensible record /extensible Δ a |
|
-- |
|
-- higher-kinded data to represent widget tree / state tree ... how to select? |
|
-- record as widget tree? record as stateful widget like flutter? record as state tree? fultter's build context? |
|
-- |
|
-- pairValues :: Δ a -> Δ b -> Δ (a,b) |
|
-- pairValues = liftA2 (,) |
