[Haskell-cafe] How to improve below code?

Ryan Ingram ryani.spam at gmail.com
Tue Jun 9 16:23:17 EDT 2009


On Tue, Jun 9, 2009 at 7:21 AM, Neil Brown<nccb2 at kent.ac.uk> wrote:
> data Page a =
>   Page {pageName      :: IORef String
>        ,pageId        :: Int
>        ,pageBuffer    :: a
>        ,pageBox       :: VBox
>        }
>
> class PageBuffer a where
>  pageBufferClone :: a -> IO (a, VBox)
>
> pageClone :: PageBuffer a => Page a -> IO (Page a)
> pageClone page = do
>  -- Get common information for clone page.
>  name <- pageGetName page
>  let id = pageId page
>     pb = pageBuffer page
>
>  -- Get clone information for dynamic interface.  (pBuffer, pBox) <-
> pageBufferClone pb
>
>  -- Return clone page.
>  pageNewInternal name id pBuffer pBox

Actually you can avoid the type parameter on "a" using an existential:

> {-# LANGUAGE ExistentialQuantification #-}
> data Page = forall a. PageBuffer a =>
>   Page {pageName      :: IORef String
>        ,pageId        :: Int
>        ,pageBuffer    :: a
>        ,pageBox       :: VBox
>        }

Now you can still use [Page].  You can't do "pageBuffer p", though,
you'll get this fun error message:
    Cannot use record selector `pageBuffer' as a function due to
escaped type variables
    Probable fix: use pattern-matching syntax instead

Instead you need to do
    case p of Page{pageBuffer = x} -> ...something with x...

This will bring the PageBuffer context into scope, inside of the case statement.

  -- ryan


More information about the Haskell-Cafe mailing list