mvc-1.1.1: Model-view-controller

Safe HaskellSafe




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



producer :: Buffer a -> Producer a IO () -> Managed (Controller a) Source

Create a Controller from a Producer, using the given Buffer

If you're not sure what Buffer to use, try Single

stdinLines :: Managed (Controller String) Source

Read lines from standard input

inLines :: FilePath -> Managed (Controller String) Source

Read lines from a file

inRead :: Read a => FilePath -> Managed (Controller a) Source

read values from a file, one value per line, skipping failed parses

tick :: Double -> Managed (Controller ()) Source

Emit empty values spaced by a delay in seconds


consumer :: Consumer a IO () -> Managed (View a) Source

Create a View from a Consumer

stdoutLines :: View String Source

Write lines to standard output

outLines :: FilePath -> Managed (View String) Source

Write lines to a file

outShow :: Show a => FilePath -> Managed (View a) Source

show values to a file, one value per line



forkManaged Source


:: IO (IO (), a, IO ())

Setup action returning thread's main, managed value, finalizer.

-> Managed a 

Fork managed computation in a new thread. See producer source for usage 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 join surrounding the managed block. This is because the type before 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 >~ 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.