[Haskell-cafe] "with" and "preserving" for local state
Jules Bean
jules at jellybean.co.uk
Wed Oct 3 09:08:43 EDT 2007
Lots of external libraries contain state, but one that really contains a
*lot* of state is the OpenGL libraries, since OpenGL is specified as a
statemachine.
This means that when you're writing structured code you quite often want
to save and restore chunks of state 'automatically'. For the very most
common case (coordinate transformations) Sven gives us
'preservingMatrix' which is extremely handy. Unless I've missed
something there's no similar API for saving/restoring arbitrary state
variables. It's not hard to write:
> {-# OPTIONS -fglasgow-exts #-}
> import Graphics.Rendering.OpenGL
> import Graphics.UI.GLUT
>
> preserving :: (HasSetter g, HasGetter g) => g a -> IO t -> IO t
> preserving var act = do old <- get var
> ret <- act
> var $= old
> return ret
This enables us to write
preserving lighting $ do .....
Note that, since IORef is an instance of HasGetter and HasSetter, you
can do 'preserving' on any old IORef, not just an openGL StateVar.
Also note that the 'makeStateVar' interface that
Graphics.Rendering.OpenGL.GL.StateVar exports allows you to make a
statevar out of any appropriate action pair (not entirely unrelated to
http://twan.home.fmf.nl/blog/haskell/overloading-functional-references.details)
Sometimes you don't only want to preserve a value, but set a specific
temporary value, so:
> with :: (HasSetter g, HasGetter g) => g a -> a -> IO t -> IO t
> with var val act = do old <- get var
> var $= val
> ret <- act
> var $= old
> return ret
with lighting Enabled $ do ....
(of course, with could be written as
with var val act = preserving var $ var $= val >> act
)
But this gets really clumsy if you have multiple variables to
save/restore, which is really what lead me to write this message in the
first place. A cute syntax for doing multiple save/restores at once is
given by an existential:
> data TemporaryValue = forall a g.
> (HasGetter g,HasSetter g) =>
> g a := a
>
> with' :: [TemporaryValue] -> IO t -> IO t
> with' tvs act = do olds <- mapM (\(a := b) -> do old <- get a
> return (a := old))
> tvs
> ret <- act
> mapM_ (\(a := b) -> a $= b) tvs
> return ret
so we can then write:
with' [lighting := Enabled, currentColor := Color4 1 0 1 0] $ do ...
and have a type safe list of temporary assignments passed as an
argument. And, amazingly, you get decent error messages too:
*Main> :t with' [lighting := Enabled, currentColor := Color4 1 0 1 0]
with' [lighting := Enabled, currentColor := Color4 1 0 1 0] :: IO t -> IO t
*Main> :t with' [lighting := Enabled, currentColor := "Foo"]
<interactive>:1:44:
Couldn't match expected type `Color4 GLfloat'
against inferred type `[Char]'
In the second argument of `(:=)', namely `"Foo"'
In the expression: currentColor := "Foo"
In the first argument of `with'', namely
`[lighting := Enabled, currentColor := "Foo"]'
Hope someone else finds that useful,
Jules
More information about the Haskell-Cafe
mailing list