mvc 1.0.1 → 1.0.2

raw patch · 3 files changed

+22/−59 lines, 3 filesdep +manageddep ~contravariantdep ~pipesdep ~transformers

Dependencies added: managed

Dependency ranges changed: contravariant, pipes, transformers

Files

• mvc.cabal +5/−4
• src/MVC.hs +2/−47
• src/MVC/Prelude.hs +15/−8

@@ -1,5 +1,5 @@ Name: mvc-Version: 1.0.1+Version: 1.0.2 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -28,11 +28,12 @@     Build-Depends:         base              >= 4       && < 5  ,         async             >= 2.0.0   && < 2.1,-        contravariant                   < 0.7,+        contravariant                   < 1.3,+        managed                         < 1.1,         mmorph            >= 1.0.2   && < 1.1,-        pipes             >= 4.0.0   && < 4.2,+        pipes             >= 4.1.0   && < 4.2,         pipes-concurrency >= 2.0.1   && < 2.1,-        transformers      >= 0.2.0.0 && < 0.5 +        transformers      >= 0.2.0.0 && < 0.4      Exposed-Modules:         MVC,         MVC.Prelude

@@ -102,8 +102,8 @@     , module Pipes.Concurrent     ) where -import Control.Applicative (Applicative(pure, (<*>)), liftA2) import Control.Category (Category(..))+import Control.Monad.Managed (Managed, managed, with) import Control.Monad.Morph (generalize) import Control.Monad.Trans.State.Strict (State, execStateT) import Data.Functor.Constant (Constant(Constant, getConstant))@@ -353,7 +353,7 @@     -> IO s     -- ^ Returns final state runMVC initialState (AsPipe pipe) viewController =-    _bind viewController $ \(AsSink sink, AsInput input) ->+    with viewController $ \(AsSink sink, AsInput input) ->     flip execStateT initialState $ runEffect $             fromInput input         >-> hoist (hoist generalize) pipe@@ -367,52 +367,7 @@      See the source code for the \"Utilities\" section below for several examples     of how to create `Managed` resources.--    Note that `runMVC` is the only way to consume `Managed` resources. -}---- | A managed resource-newtype Managed r = Managed { _bind :: forall x . (r -> IO x) -> IO x }--- `Managed` is the same thing as `Codensity IO` or `forall x . ContT x IO`------ I implement a custom type instead of reusing those types because:------ * I need a non-orphan `Monoid` instance------ * The name and type are simpler--instance Functor Managed where-    fmap f mx = Managed (\_return ->-        _bind mx (\x ->-        _return (f x) ) )--instance Applicative Managed where-    pure r    = Managed (\_return ->-        _return r )-    mf <*> mx = Managed (\_return ->-        _bind mf (\f ->-        _bind mx (\x ->-        _return (f x) ) ) )--instance Monad Managed where-    return r = Managed (\_return ->-        _return r )-    ma >>= f = Managed (\_return ->-        _bind  ma   (\a ->-        _bind (f a) (\b ->-        _return b ) ) )--instance Monoid r => Monoid (Managed r) where-    mempty  = pure mempty-    mappend = liftA2 mappend--instance MonadIO Managed where-    liftIO m = Managed (m >>=)---- | Created a `Managed` resource-managed :: (forall x . (r -> IO x) -> IO x) -> Managed r-managed = Managed-{-# INLINABLE managed #-}  {-| Create a `Pipe` from a `ListT` transformation 

@@ -77,15 +77,22 @@ -- | Create a `View` from a `Consumer` consumer :: Consumer a IO () -> Managed (View a) consumer cons0 = managed $ \k -> do-    ref <- newIORef cons0+    mf0 <- nextRequest cons0+    ref <- newIORef mf0     k $ asSink $ \a -> do-        cons <- readIORef ref-        let go cons_ = case cons_ of-                Request () fa -> writeIORef ref (fa a)-                Respond v  _  -> closed v-                M          m  -> m >>= go-                Pure    r     -> writeIORef ref (return r)-        go cons+        mf <- readIORef ref+        case mf of+            Nothing -> return ()+            Just f  -> do+                mf' <- nextRequest (f a)+                writeIORef ref mf'+  where+    nextRequest :: Consumer a IO () -> IO (Maybe (a -> Consumer a IO ()))+    nextRequest cons = case cons of+        Request () fa -> return (Just fa)+        Respond v  _  -> closed v+        M          m  -> m >>= nextRequest+        Pure       () -> return Nothing {-# INLINABLE consumer #-}      -- | Write lines to standard output