miso 0.7.4.0 → 0.7.5.0

raw patch · 5 files changed

+17/−41 lines, 5 filesdep −BoundedChanPVP ok

version bump matches the API change (PVP)

Dependencies removed: BoundedChan

API changes (from Hackage documentation)

Files

• examples/mario/Main.hs +3/−3
• ghcjs-src/Miso.hs +7/−14
• ghcjs-src/Miso/Effect.hs +5/−0
• miso.cabal +1/−2
• src/Miso/Concurrent.hs +1/−22

@@ -64,8 +64,8 @@     }  updateMario :: Action -> Model -> Effect Action Model-updateMario NoOp m = noEff m-updateMario (GetArrows arrs) m = step newModel+updateMario NoOp m = step m+updateMario (GetArrows arrs) m = noEff newModel   where     newModel = m { arrows = arrs } updateMario (Time newTime) m = step newModel@@ -73,7 +73,7 @@     newModel = m { delta = (newTime - time m) / 20                  , time = newTime                  }-updateMario (WindowCoords coords) m = step newModel+updateMario (WindowCoords coords) m = noEff newModel   where     newModel = m { window = coords } 

@@ -53,21 +53,16 @@ common App {..} m getView = do   -- init Notifier   Notify {..} <- newNotify-  -- init EventWriter-  EventWriter {..} <- newEventWriter   -- init empty Model   modelRef <- newIORef m   -- init empty actions-  actionsMVar <- newMVar S.empty+  actionsRef <- newIORef S.empty+  let writeEvent a = void . forkIO $ do+        atomicModifyIORef' actionsRef $ \as -> (as |> a, ())+        notify   -- init Subs   forM_ subs $ \sub ->     sub (readIORef modelRef) writeEvent-  -- init event application thread-  void . forkIO . forever $ do-    action <- getEvent-    modifyMVar_ actionsMVar $! \actions -> do-      pure (actions |> action)-    notify   -- Hack to get around `BlockedIndefinitelyOnMVar` exception   -- that occurs when no event handlers are present on a template   -- and `notify` is no longer in scope@@ -81,15 +76,13 @@   -- Program loop, blocking on SkipChan   forever $ wait >> do     -- Apply actions to model-    shouldDraw <--      modifyMVar actionsMVar $! \actions -> do-        (shouldDraw, effects) <- atomicModifyIORef' modelRef $! \oldModel ->+    actions <- atomicModifyIORef' actionsRef $ \actions -> (S.empty, actions)+    (shouldDraw, effects) <- atomicModifyIORef' modelRef $! \oldModel ->           let (newModel, effects) =                 foldl' (foldEffects writeEvent update)                   (oldModel, pure ()) actions           in (newModel, (oldModel /= newModel, effects))-        effects-        pure (S.empty, shouldDraw)+    effects     when shouldDraw $ do       newVTree <-         flip runView writeEvent

@@ -17,6 +17,8 @@ , (#>) ) where +import Data.Bifunctor+ import Miso.Effect.Storage import Miso.Effect.XHR import Miso.Effect.DOM@@ -41,6 +43,9 @@   Effect m acts >>= f =     case f m of       Effect m' acts' -> Effect m' (acts ++ acts')++instance Bifunctor Effect where+  bimap f g (Effect m acts) = Effect (g m) (map (fmap f) acts)  -- | Smart constructor for an 'Effect' with no actions. noEff :: model -> Effect action model

@@ -1,5 +1,5 @@ name:                miso-version:             0.7.4.0+version:             0.7.5.0 category:            Web, Miso, Data Structures license:             BSD3 license-file:        LICENSE@@ -260,7 +260,6 @@     aeson,     base < 5,     bytestring,-    BoundedChan,     containers,     servant,     text

@@ -11,29 +11,9 @@ module Miso.Concurrent (     Notify (..)   , newNotify-  , EventWriter (..)-  , newEventWriter   ) where -import Control.Concurrent hiding (readChan)-import Control.Concurrent.BoundedChan-import Control.Monad---- | Concurrent API for receiving events and writing to an event sink-data EventWriter action = EventWriter {-    writeEvent :: action -> IO ()-  , getEvent :: IO action-  }---- | Creates a new `EventWriter`-newEventWriter :: IO (EventWriter m)-newEventWriter = do-  chan <- newBoundedChan 50-  pure $ EventWriter (write chan) (readChan chan)-    where-      write chan event =-        void . forkIO $ do-          void $ tryWriteChan chan $! event+import Control.Concurrent  -- | Concurrent API for `SkipChan` implementation data Notify = Notify {@@ -48,4 +28,3 @@   pure $ Notify    (takeMVar mvar)    (() <$ do tryPutMVar mvar $! ())-