MVC.Prelude

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

Controllers

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

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)

Read lines from standard input

inLines :: FilePath -> Managed (Controller String)

Read lines from a file

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

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

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

Emit empty values spaced by a delay in seconds

Views

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

Create a View from a Consumer

stdoutLines :: View String

Write lines to standard output

outLines :: FilePath -> Managed (View String)

Write lines to a file

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

show values to a file, one value per line

Handles

inHandle :: FilePath -> Managed Handle

Read from a FilePath using a Managed Handle

outHandle :: FilePath -> Managed Handle

Write to a FilePath using a Managed Handle

Threads

forkManaged

Arguments

:: 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.

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 Control.Monad.Managed (managed_)
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 = do
    managed_ (withInit [InitVideo, InitEventthread])
    surface <- liftIO $ setVideoMode 640 480 32 [SWSurface]
    white   <- liftIO $ 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

    totalIn <- producer Single (lift waitEvent >~ cat)
    return (totalOut, totalIn)

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.