mvc-updates 1.1.1 → 1.1.2

raw patch · 2 files changed

+34/−45 lines, 2 filesdep ~foldldep ~mvc

Dependency ranges changed: foldl, mvc

Files

• mvc-updates.cabal +3/−3
• src/MVC/Updates.hs +31/−42

@@ -1,5 +1,5 @@ Name: mvc-updates-Version: 1.1.1+Version: 1.1.2 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -29,7 +29,7 @@     Build-Depends:         base  >= 4     && < 5  ,         async >= 2.0.0 && < 2.1,-        foldl >= 1.0.6 && < 1.1,-        mvc               < 1.1+        foldl >= 1.1.0 && < 1.2,+        mvc   >= 1.1.0 && < 1.2     Exposed-Modules: MVC.Updates     GHC-Options: -O2 -Wall

@@ -89,7 +89,6 @@       Updatable(..)     , on     , listen-    , transform     , runUpdatable     , updates @@ -101,12 +100,11 @@     , module Control.Foldl     ) where -import Control.Applicative (Applicative(pure, (<*>)), (<*))+import Control.Applicative (Applicative(pure, (<*>)), (<*), liftA2) import Control.Category (id) import Control.Concurrent.Async (withAsync) import Control.Foldl (FoldM(..), Fold(..))-import qualified Control.Foldl as Foldl-import Control.Monad ((>=>))+import qualified Control.Foldl as L import Data.IORef (newIORef, readIORef, writeIORef) import MVC import Prelude hiding (id)@@ -139,10 +137,10 @@ -}  -- | A concurrent, updatable value-data Updatable a = forall e . On (FoldM IO e a) (Managed (Controller e))+data Updatable a = forall e . Updatable (Managed (Controller e, FoldM IO e a))  instance Functor Updatable where-    fmap f (On fold mController) = On (fmap f fold) mController+    fmap f (Updatable m) = Updatable (fmap (fmap (fmap f)) m)  -- _Left :: Traversable' (Either a b) a _Left :: Applicative f => (a -> f a) -> (Either a b -> f (Either a b))@@ -157,19 +155,19 @@     Right b -> fmap Right (k b)  instance Applicative Updatable where-    pure a = On (pure a) mempty+    pure a = Updatable (pure (pure (pure a))) -    (On foldL mControllerL) <*> (On foldR mControllerR) = On foldT mControllerT+    Updatable mL <*> Updatable mR = Updatable (liftA2 f mL mR)       where-        foldT =-            Foldl.pretraverseM _Left foldL <*> Foldl.pretraverseM _Right foldR+        f (controllerL, foldL) (controllerR, foldR) = (controllerT, foldT)+          where+            foldT = L.handlesM _Left foldL <*> L.handlesM _Right foldR -        mControllerT =-            fmap (fmap Left) mControllerL <> fmap (fmap Right) mControllerR+            controllerT = fmap Left controllerL <> fmap Right controllerR  -- | Create an `Updatable` value using a pure `Fold` on :: Fold e a -> Managed (Controller e) -> Updatable a-on fold = On (Foldl.generalize fold)+on fold m = Updatable (fmap (\controller -> (controller, L.generalize fold)) m) {-# INLINABLE on #-}  {-| Attach a listener that runs every time an `Updatable` value updates@@ -181,43 +179,34 @@ > listen (f <> g) = listen g . listen f -} listen :: (a -> IO ()) -> Updatable a -> Updatable a-listen handler (On (FoldM step begin done) mController) =-    On (FoldM step' begin' done) mController+listen handler (Updatable m) = Updatable (fmap f m)   where-    begin' = do-        x <- begin-        b <- done x-        handler b-        return x-    step' x a = do-        x' <- step x a-        b  <- done x'-        handler b-        return x'+    f (controller, FoldM step  begin  done) =+      (controller, FoldM step' begin' done)+      where+        begin' = do+            x <- begin+            b <- done x+            handler b+            return x+        step' x a = do+            x' <- step x a+            b  <- done x'+            handler b+            return x' {-# INLINABLE listen #-} -{-| Transform an `Updatable` value using an impure function--> transform return = id->-> transform (f >=> g) = transform g . transform f--}-transform :: (a -> IO b) -> Updatable a -> Updatable b-transform f (On (FoldM step begin  done       ) mController) =-             On (FoldM step begin (done >=> f)) mController-{-# INLINABLE transform #-}- {-| Run an `Updatable` value, discarding the result      Use this if you only care about running the associated listeners -} runUpdatable :: Updatable a -> IO ()-runUpdatable (On (FoldM step begin done) mController) = runMVC () id $ do-    controller <- mController+runUpdatable (Updatable m) = runMVC () id $ do+    (controller, FoldM step begin done) <- m      ioref <- liftIO $ do-        x     <- begin-        _     <- done x+        x <- begin+        _ <- done x         newIORef x      let view = asSink $ \e -> do@@ -234,8 +223,8 @@     You must specify how to `Buffer` the updates -} updates :: Buffer a -> Updatable a -> Managed (Controller a)-updates buffer (On (FoldM step begin done) mController) = do-    controller <- mController+updates buffer (Updatable m) = do+    (controller, FoldM step begin done) <- m     managed $ \k -> do         (o, i, seal) <- spawn' buffer