mvc (empty) → 1.0.0
raw patch · 5 files changed
+795/−0 lines, 5 filesdep +asyncdep +basedep +contravariantsetup-changed
Dependencies added: async, base, contravariant, mmorph, pipes, pipes-concurrency, transformers
Files
- LICENSE +24/−0
- Setup.hs +2/−0
- mvc.cabal +39/−0
- src/MVC.hs +515/−0
- src/MVC/Prelude.hs +215/−0
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2013 Gabriel Gonzalez+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.+ * Neither the name of Gabriel Gonzalez nor the names of other contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mvc.cabal view
@@ -0,0 +1,39 @@+Name: mvc+Version: 1.0.0+Cabal-Version: >=1.8.0.2+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: 2013 Gabriel Gonzalez+Author: Gabriel Gonzalez+Maintainer: Gabriel439@gmail.com+Bug-Reports: https://github.com/Gabriel439/Haskell-MVC-Library/issues+Synopsis: Model-view-controller+Description: Use the @mvc@ library to distill concurrent programs into pure and+ single-threaded programs using the @Model@-@View@-@Controller@ pattern. This+ transformation lets you:+ .+ * replay your program deterministically,+ .+ * do property-based testing of your model (like @QuickCheck@), and:+ .+ * equationally reason about your pure core.+Category: Control, Concurrency+Source-Repository head+ Type: git+ Location: https://github.com/Gabriel439/Haskell-MVC-Library++Library+ Hs-Source-Dirs: src+ Build-Depends:+ base >= 4 && < 5 ,+ async >= 2.0.0 && < 2.1,+ contravariant < 0.5,+ mmorph >= 1.0.0 && < 1.1,+ pipes >= 4.0.0 && < 4.2,+ pipes-concurrency >= 2.0.1 && < 2.1,+ transformers >= 0.2.0.0 && < 0.4 + Exposed-Modules:+ MVC,+ MVC.Prelude+ GHC-Options: -O2 -Wall
+ src/MVC.hs view
@@ -0,0 +1,515 @@+{-| Use the `Model` - `View` - `Controller` pattern to separate impure inputs+ and outputs from pure application logic so that you can:++ * Equationally reason about your model++ * Exercise your model with property-based testing (like @QuickCheck@)++ * Reproducibly replay your model++ The @mvc@ library uses the type system to statically enforce the separation+ of impure `View`s and `Controller`s from the pure `Model`.++ Here's a small example program written using the @mvc@ library to illustrate+ the core types and concepts:++> import MVC+> import qualified MVC.Prelude as MVC+> import qualified Pipes.Prelude as Pipes+>+> external :: Managed (View String, Controller String)+> external = do+> c1 <- MVC.stdinLines+> c2 <- MVC.tick 1+> return (MVC.stdoutLines, c1 <> fmap show c2)+>+> model :: Model () String String+> model = asPipe (Pipes.takeWhile (/= "quit"))+> +> main :: IO ()+> main = runMVC () model external++ This program has three components:++ * A `Controller` that interleaves lines from standard input with periodic+ ticks++ * A `View` that writes lines to standard output++ * A pure `Model`, which forwards lines until the user inputs @"quit"@++ 'runMVC' connects them into a complete program, which outputs a @()@ every+ second and also echoes standard input to standard output until the user+ enters @"quit"@:++>>> main+()+Test<Enter>+Test+()+()+42<Enter>+42+()+quit<enter>+>>>++ The following sections give extended guidance for how to structure @mvc@+ programs. Additionally, there is an "MVC.Prelude" module, which provides+ several utilities and provides a more elaborate code example using the+ @sdl@ library.+-}++{-# LANGUAGE RankNTypes #-}++module MVC (+ -- * Controllers+ -- $controller+ Controller+ , asInput+ , keeps++ -- * Views+ -- $view+ , View+ , asSink+ , handles++ -- * Models+ -- $model+ , Model+ , asPipe++ -- * MVC+ -- $mvc+ , runMVC++ -- * Managed resources+ -- $managed+ , Managed+ , managed++ -- *ListT+ , loop+ -- $listT++ -- * Re-exports+ -- $reexports+ , module Data.Functor.Constant+ , module Data.Functor.Contravariant+ , module Data.Monoid+ , module Pipes+ , module Pipes.Concurrent+ ) where++import Control.Applicative (Applicative(pure, (<*>)), liftA2)+import Control.Category (Category(..))+import Control.Monad.Morph (generalize)+import Control.Monad.Trans.State.Strict (State, execStateT)+import Data.Functor.Constant (Constant(Constant, getConstant))+import Data.Functor.Contravariant (Contravariant(contramap))+import Data.Monoid (Monoid(mempty, mappend, mconcat), (<>), First)+import qualified Data.Monoid as M+import Pipes+import Pipes.Concurrent++import Prelude hiding ((.), id)++{- $controller+ `Controller`s represent concurrent inputs to your system. Use the `Functor`+ and `Monoid` instances for `Controller` and `Managed` to unify multiple+ `Managed` `Controller`s together into a single `Managed` `Controller`:++> controllerA :: Managed (Controller A)+> controllerB :: Managed (Controller B)+> controllerC :: Managed (Controller C)+>+> data TotalInput = InA A | InB B | InC C+>+> controllerTotal :: Managed (Controller TotalInput)+> controllerTotal =+> fmap (fmap InA) controllerA+> <> fmap (fmap InB) controllerB+> <> fmap (fmap InC) controllerC++ Combining `Controller`s interleaves their values.+-}++{-| A concurrent source++> fmap f (c1 <> c2) = fmap f c1 <> fmap f c2+>+> fmap f mempty = mempty+-}+newtype Controller a = AsInput (Input a)+-- This is just a newtype wrapper around `Input` because:+--+-- * I want the `Controller` name to "stick" in inferred types+--+-- * I want to restrict the API to ensure that `runMVC` is the only way to+-- consume `Controller`s. This enforces strict separation of `Controller`+-- logic from `Model` or `View` logic++-- Deriving `Functor`+instance Functor Controller where+ fmap f (AsInput i) = AsInput (fmap f i)++-- Deriving `Monoid`+instance Monoid (Controller a) where+ mappend (AsInput i1) (AsInput i2) = AsInput (mappend i1 i2)++ mempty = AsInput mempty++-- | Create a `Controller` from an `Input`+asInput :: Input a -> Controller a+asInput = AsInput+{-# INLINABLE asInput #-}++{-| Think of the type as one of the following types:++> keeps :: Prism' a b -> Controller a -> Controller b+> keeps :: Traversal' a b -> Controller a -> Controller b++ @(keeps prism controller)@ only emits values if the @prism@ matches the+ @controller@'s output.++> keeps (p1 . p2) = keeps p2 . keeps p1+>+> keeps id = id++> keeps p (c1 <> c2) = keeps p c1 <> keeps p c2+>+> keeps p mempty = mempty+-}+keeps+ :: ((b -> Constant (First b) b) -> (a -> Constant (First b) a))+ -- ^+ -> Controller a+ -- ^+ -> Controller b+keeps k (AsInput (Input recv_)) = AsInput (Input recv_')+ where+ recv_' = do+ ma <- recv_+ case ma of+ Nothing -> return Nothing+ Just a -> case match a of+ Nothing -> recv_'+ Just b -> return (Just b)+ match = M.getFirst . getConstant . k (Constant . M.First . Just)+{-# INLINABLE keeps #-}++{- $view+ `View`s represent outputs of your system. Use `handles` and the `Monoid`+ instance of `View` to unify multiple `View`s together into a single `View`:++> viewD :: Managed (View D)+> viewE :: Managed (View E)+> viewF :: Managed (View F)+>+> data TotalOutput = OutD D | OutE E | OutF F+>+> makePrisms ''TotalOutput -- Generates _OutD, _OutE, and _OutF prisms+>+> viewTotal :: Managed (View TotalOutput)+> viewTotal =+> fmap (handles _OutD) viewD+> <> fmap (handles _OutE) viewE+> <> fmap (handles _OutF) viewF++ Combining `View`s sequences their outputs.++ If a @lens@ dependency is too heavy-weight, then you can manually generate+ `Traversal`s, which `handles` will also accept. Here is an example of how+ you can generate `Traversal`s by hand with no dependencies:++> -- _OutD :: Traversal' TotalOutput D+> _OutD :: Applicative f => (D -> f D) -> (TotalOutput -> f TotalOutput)+> _OutD k (OutD d) = fmap OutD (k d)+> _OutD k t = pure t+>+> -- _OutE :: Traversal' TotalOutput E+> _OutE :: Applicative f => (E -> f E) -> (TotalOutput -> f TotalOutput)+> _OutE k (OutE d) = fmap OutE (k d)+> _OutE k t = pure t+>+> -- _OutF :: Traversal' TotalOutput F+> _OutF :: Applicative f => (F -> f F) -> (TotalOutput -> f TotalOutput)+> _OutF k (OutF d) = fmap OutF (k d)+> _OutF k t = pure t+-}++{-| An effectful sink++> contramap f (v1 <> v2) = contramap f v1 <> contramap f v2+>+> contramap f mempty = mempty+-}+newtype View a = AsSink (a -> IO ())++instance Monoid (View a) where+ mempty = AsSink (\_ -> return ())+ mappend (AsSink write1) (AsSink write2) =+ AsSink (\a -> write1 a >> write2 a)++instance Contravariant View where+ contramap f (AsSink k) = AsSink (k . f)++-- | Create a `View` from a sink+asSink :: (a -> IO ()) -> View a+asSink = AsSink +{-# INLINABLE asSink #-}++{-| Think of the type as one of the following types:++> handles :: Prism' a b -> View b -> View a+> handles :: Traversal' a b -> View b -> View a++ @(handles prism view)@ only runs the @view@ if the @prism@ matches the+ input.++> handles (p1 . p2) = handles p1 . handles p2+>+> handles id = id++> handles p (v1 <> v2) = handles p v1 <> handles p v2+>+> handles p mempty = mempty+-}+handles+ :: ((b -> Constant (First b) b) -> (a -> Constant (First b) a))+ -- ^+ -> View b+ -- ^+ -> View a+handles k (AsSink send_) = AsSink (\a -> case match a of+ Nothing -> return ()+ Just b -> send_ b )+ where+ match = M.getFirst . getConstant . k (Constant . M.First . Just)+{-# INLINABLE handles #-}++{- $model+ `Model`s are stateful streams and they sit in between `Controller`s and+ `View`s.++ Use `State` to internally communicate within the `Model`.++ Read the \"ListT\" section which describes why you should prefer `ListT`+ over `Pipe` when possible.++ Also, try to defer converting your `Pipe` to a `Model` until you call+ `runMVC`, because the conversion is not reversible and `Pipe` is strictly+ more featureful than `Model`.+-}++{-| A @(Model s a b)@ converts a stream of @(a)@s into a stream of @(b)@s while+ interacting with a state @(s)@+-}+newtype Model s a b = AsPipe (Pipe a b (State s) ())++instance Category (Model s) where+ (AsPipe m1) . (AsPipe m2) = AsPipe (m1 <-< m2)++ id = AsPipe cat++{-| Create a `Model` from a `Pipe`++> asPipe (p1 <-< p2) = asPipe p1 . asPipe p2+>+> asPipe cat = id+-}+asPipe :: Pipe a b (State s) () -> Model s a b+asPipe = AsPipe+{-# INLINABLE asPipe #-}++{- $mvc+ Connect a `Model`, `View`, and `Controller` and an initial state+ together using `runMVC` to complete your application.++ `runMVC` is the only way to consume `View`s and `Controller`s. The types+ forbid you from mixing `View` and `Controller` logic with your `Model`+ logic.++ Note that `runMVC` only accepts one `View` and one `Controller`. This+ enforces a single entry point and exit point for your `Model` so that you+ can cleanly separate your `Model` logic from your `View` logic and+ `Controller` logic. The way you add more `View`s and `Controller`s to your+ program is by unifying them into a single `View` or `Controller` by using+ their `Monoid` instances. See the \"Controllers\" and \"Views\" sections+ for more details on how to do this.+-}++{-| Connect a `Model`, `View`, and `Controller` and initial state into a+ complete application.+-}+runMVC+ :: s+ -- ^ Initial state+ -> Model s a b+ -- ^ Program logic+ -> Managed (View b, Controller a)+ -- ^ Effectful output and input+ -> IO s+ -- ^ Returns final state+runMVC initialState (AsPipe pipe) viewController =+ _bind viewController $ \(AsSink sink, AsInput input) ->+ flip execStateT initialState $ runEffect $+ fromInput input+ >-> hoist (hoist generalize) pipe+ >-> for cat (liftIO . sink)+{-# INLINABLE runMVC #-}++{- $managed+ Use `managed` to create primitive `Managed` resources and use the `Functor`,+ `Applicative`, `Monad`, and `Monoid` instances for `Managed` to bundle+ multiple `Managed` resources into a single `Managed` resource.++ 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++-- | 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++> loop (k1 >=> k2) = loop k1 >-> loop k2+>+> loop return = cat+-}+loop :: Monad m => (a -> ListT m b) -> Pipe a b m r+loop k = for cat (every . k)+{-# INLINABLE loop #-}++{- $listT+ `ListT` computations can be combined in more ways than `Pipe`s, so try to+ program in `ListT` as much as possible and defer converting it to a `Pipe`+ as late as possible using `loop`.++ You can combine `ListT` computations even if their inputs and outputs are+ completely different:++> -- Independent computations+>+> modelAToD :: A -> ListT (State S) D+> modelBToE :: B -> ListT (State S) E+> modelCToF :: C -> ListT (State s) F+>+> modelInToOut :: TotalInput -> ListT (State S) TotalOutput+> modelInToOut totalInput = case totalInput of+> InA a -> fmap OutD (modelAToD a)+> InB b -> fmap OutE (modelAToD b)+> InC c -> fmap OutF (modelAToD c)++ Sometimes you have multiple computations that handle different inputs but+ the same output, in which case you don't need to unify their outputs:++> -- Overlapping outputs+>+> modelAToOut :: A -> ListT (State S) Out+> modelBToOut :: B -> ListT (State S) Out+> modelCToOut :: C -> ListT (State S) Out+>+> modelInToOut :: TotalInput -> ListT (State S) TotalOutput+> modelInToOut totalInput = case totalInput of+> InA a -> modelAToOut a+> InB b -> modelBToOut b+> InC c -> modelBToOut b++ Other times you have multiple computations that handle the same input but+ produce different outputs. You can unify their outputs using the `Monoid`+ and `Functor` instances for `ListT`:++> -- Overlapping inputs+>+> modelInToA :: TotalInput -> ListT (State S) A+> modelInToB :: TotalInput -> ListT (State S) B+> modelInToC :: TotalInput -> ListT (State S) C+>+> modelInToOut :: TotalInput -> ListT (State S) TotalOutput+> modelInToOut totalInput =+> fmap OutA (modelInToA totalInput)+> <> fmap OutB (modelInToB totalInput)+> <> fmap OutC (modelInToC totalInput)++ You can also chain `ListT` computations, feeding the output of the first+ computation as the input to the next computation:++> -- End-to-end+>+> modelInToMiddle :: TotalInput -> ListT (State S) MiddleStep+> modelMiddleToOut :: MiddleStep -> ListT (State S) TotalOutput+>+> modelInToOut :: TotalInput -> ListT (State S) TotalOutput+> modelInToOut = modelInToMiddle >=> modelMiddleToOut++ ... or you can just use @do@ notation if you prefer.++ However, the `Pipe` type is more general than `ListT` and can represent+ things like termination. Therefore you should consider mixing `Pipe`s with+ `ListT` when you need to take advantage of these extra features:++> -- Mix ListT with Pipes+>+> pipe :: Pipe TotalInput TotalOutput (State S) ()+> pipe = Pipes.takeWhile (not . isC)) >-> loop modelInToOut+> where+> isC (InC _) = True+> isC _ = False++ So promote your `ListT` logic to a `Pipe` when you need to take advantage of+ these `Pipe`-specific features.+-}++{- $reexports+ "Data.Functor.Constant" re-exports `Constant`++ "Data.Functor.Contravariant" re-exports `Contravariant`++ "Data.Monoid" re-exports `Monoid`, (`<>`), `mconcat`, and `First` (the type+ only)++ "Pipes" re-exports everything++ "Pipes.Concurrent" re-exports everything+-}
+ src/MVC/Prelude.hs view
@@ -0,0 +1,215 @@+{-| Simple utilities++ The \"Example\" section at the bottom of this module contains an extended+ example of how to interact with the @sdl@ library using the @mvc@ library+-}++module MVC.Prelude (+ -- * Controllers+ producer+ , stdinLines+ , inLines+ , inRead+ , tick++ -- * Views+ , consumer+ , stdoutLines+ , outLines+ , outShow++ -- * Handles+ , inHandle+ , outHandle++ -- * Example+ -- $example+ ) where++import Control.Applicative (pure, (<*))+import Control.Concurrent.Async (withAsync)+import Control.Concurrent (threadDelay)+import Data.IORef (newIORef, readIORef, writeIORef)+import MVC+import Pipes.Internal (Proxy(..), closed)+import qualified Pipes.Prelude as Pipes+import qualified System.IO as IO++{-| Create a `Controller` from a `Producer`, using the given `Buffer`++ If you're not sure what `Buffer` to use, try `Single`+-}+producer :: Buffer a -> Producer a IO () -> Managed (Controller a)+producer buffer prod = managed $ \k -> do+ (o, i, seal) <- spawn' buffer+ let io = do+ runEffect $ prod >-> toOutput o+ atomically seal+ withAsync io $ \_ -> k (asInput i) <* atomically seal+{-# INLINABLE producer #-}++-- | Read lines from standard input+stdinLines :: Managed (Controller String)+stdinLines = producer Single Pipes.stdinLn+{-# INLINABLE stdinLines #-}++-- | Read lines from a file+inLines :: FilePath -> Managed (Controller String)+inLines filePath = do+ handle <- inHandle filePath+ producer Single (Pipes.fromHandle handle)+{-# INLINABLE inLines #-}++-- | 'read' values from a file, one value per line, skipping failed parses+inRead :: Read a => FilePath -> Managed (Controller a)+inRead filePath = fmap (keeps parsed) (inLines filePath)+ where+ parsed k str = case reads str of+ [(a, "")] -> Constant (getConstant (k a))+ _ -> pure str+{-# INLINABLE inRead #-}++-- | Emit empty values spaced by a delay in seconds+tick :: Double -> Managed (Controller ())+tick n = producer Single $ lift (threadDelay (truncate (n * 1000000))) >~ cat+{-# INLINABLE tick #-}++-- | Create a `View` from a `Consumer`+consumer :: Consumer a IO () -> Managed (View a)+consumer cons0 = managed $ \k -> do+ ref <- newIORef cons0+ 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+{-# INLINABLE consumer #-}+ +-- | Write lines to standard output+stdoutLines :: View String+stdoutLines = asSink putStrLn+{-# INLINABLE stdoutLines #-}++-- | Write lines to a file+outLines :: FilePath -> Managed (View String)+outLines filePath = do+ handle <- outHandle filePath+ return (asSink (IO.hPutStrLn handle))+{-# INLINABLE outLines #-}++-- | 'show' values to a file, one value per line+outShow :: Show a => FilePath -> Managed (View a)+outShow filePath = fmap (contramap show) (outLines filePath)+{-+outShow filePath = do+ handle <- outHandle filePath+ return (asSink (IO.hPrint handle))+-}+{-# INLINABLE outShow #-}++-- | Read from a `FilePath` using a `Managed` `IO.Handle`+inHandle :: FilePath -> Managed IO.Handle+inHandle filePath = managed (IO.withFile filePath IO.ReadMode)+{-# INLINABLE inHandle #-}++-- | Write to a `FilePath` using a `Managed` `IO.Handle`+outHandle :: FilePath -> Managed IO.Handle+outHandle filePath = managed (IO.withFile filePath IO.WriteMode)+{-# INLINABLE outHandle #-}++{- $example+ The following example distils a @sdl@-based program into pure and impure+ components. This program will draw a white rectangle between every two+ mouse clicks.++ The first half of the program contains all the concurrent and impure logic.+ The `View` and `Controller` must be `Managed` together since they both share+ the same initialization logic:++> import Control.Monad (join)+> import Graphics.UI.SDL as SDL+> import Lens.Family.Stock (_Left, _Right) -- from `lens-family-core`+> import MVC+> import MVC.Prelude+> import qualified Pipes.Prelude as Pipes+> +> data Done = Done deriving (Eq, Show)+> +> sdl :: Managed (View (Either Rect Done), Controller Event)+> sdl = join $ managed $ \k -> withInit [InitVideo, InitEventthread] $ do+> surface <- setVideoMode 640 480 32 [SWSurface]+> white <- mapRGB (surfaceGetPixelFormat surface) 255 255 255+> +> let done :: View Done+> done = asSink (\Done -> SDL.quit)+> +> drawRect :: View Rect+> drawRect = asSink $ \rect -> do+> _ <- fillRect surface (Just rect) white+> SDL.flip surface+> +> totalOut :: View (Either Rect Done)+> totalOut = handles _Left drawRect <> handles _Right done+> +> k $ do+> totalIn <- producer Single (lift waitEvent >~ cat)+> return (totalOut, totalIn)++ Note the `Control.Monad.join` surrounding the `managed` block. This is+ because the type before `Control.Monad.join` is:++> Managed (Managed (View (Either Rect Done), Controller Event))++ More generally, note that `Managed` is a `Monad`, so you can use @do@+ notation to combine multiple `Managed` resources into a single `Managed`+ resource.++ The second half of the program contains the pure logic.++> pipe :: Monad m => Pipe Event (Either Rect Done) m ()+> pipe = do+> Pipes.takeWhile (/= Quit) >-> (click >~ rectangle >~ Pipes.map Left)+> yield (Right Done)+> +> rectangle :: Monad m => Consumer' (Int, Int) m Rect+> rectangle = do+> (x1, y1) <- await+> (x2, y2) <- await+> let x = min x1 x2+> y = min y1 y2+> w = abs (x1 - x2)+> h = abs (y1 - y2)+> return (Rect x y w h)+> +> click :: Monad m => Consumer' Event m (Int, Int)+> click = do+> e <- await+> case e of+> MouseButtonDown x y ButtonLeft ->+> return (fromIntegral x, fromIntegral y)+> _ -> click+> +> main :: IO ()+> main = runMVC () (asPipe pipe) sdl++ Run the program to verify that clicks create rectangles.++ The more logic you move into the pure core the more you can exercise your+ program purely, either manually:++>>> let leftClick (x, y) = MouseButtonDown x y ButtonLeft+>>> Pipes.toList (each [leftClick (10, 10), leftClick (15, 16), Quit] >-> pipe)+[Left (Rect {rectX = 10, rectY = 10, rectW = 5, rectH = 6}),Right Done]++ ... or automatically using property-based testing (such as @QuickCheck@):++>>> import Test.QuickCheck+>>> quickCheck $ \xs -> length (Pipes.toList (each (map leftClick xs) >-> pipe)) == length xs `div` 2++++ OK, passed 100 tests.++ Equally important, you can formally prove properties about your model using+ equational reasoning because the model is `IO`-free and concurrency-free.+-}