SharedState.hs

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 (,)