mvc-1.0.1: Model-view-controller

Safe HaskellSafe-Inferred




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 StringSource

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



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.