Bug compiling with -fglasgow-exts

[Nick Name]

I have a bug, here's the error from the compiler.

ghc -fglasgow-exts -o build/Graphics/UI/GIO/Bitmap.o -package-name gio 
-ohi build/Graphics/UI/GIO/Bitmap.hi -odir build/Graphics/UI/GIO -c 
src/Graphics/UI/GIO/Bitmap.hs  -package port -O2 -ibuild
ghc-6.0.1: panic! (the `impossible' happened, GHC version 6.0.1):
        typecheck/TcRnTypes.lhs:233: Missing field in record 
construction TcRnTypes.top_errs
 
I attach the module wich caused the error and the module Attributes, 
wich I modified. The other files can be found in the current release 
(1.0) of htoolkit at htoolkit.sourceforge.net.

Vincenzo
 
-------------- next part --------------
-----------------------------------------------------------------------------------------
{-| Module      :  Attributes
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2_mail at yahoo.com
    Stability   :  provisional
    Portability :  portable

   Widgets @w@ can have attributes of type @a@ represented by the type @Attr w a at .
   An attribute set or read. An example of an attribute is @title@ with type:

   > title :: Attr Window String

   When an attribute is associated with a value, we call it a /property/ of type @Prop w at .
   Properties are constructed with the ('=:') function:

   > title =: "hello world"  :: Prop Window

   Properties can be set with the 'set' function:

   > set win [title =: "hello world"]  :: IO ()

   and attributes can be read with the 'get' function:

   > get win title  :: IO String

   The function 'get', 'set' and '(=:)' are polymorphic and work for all widgets, but
   the @title@ attribute just works for windows. Many attributes are defined for multiple
   widgets and are organised in type classes, for example 'Deadly' and 'Dimensions'.

   The ('~:') operator is used to transform an attribute with an update function.
   For example, the 'interval' on a timer can be doubled with:

   > set timer [interval ~: (*2)]
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.GIO.Attributes
             ( 
             -- * Attributes and properties
               Attr, Prop
             , set1, set, get, with, (=:), (~:), (=::), (~::)
             
             -- * Common widget classes
           
             -- ** Dimensions
             , Dimensions
             , frame, position, size, width, height

             -- ** HasFont
             , HasFont, font
             
             -- ** Drawn
             , Drawn, bufferMode, pen
             , color, bgcolor, hatch
             , thickness, capstyle, linestyle, joinstyle 
             , drawMode, bkDrawMode
             
             -- ** Titled
             , Titled, title

             -- ** Able
             , Able, enabled
             
             -- ** ToolTip
             , ToolTip, tooltip
             
             -- ** Accelerated
             , Accelerated, accel            
               
             -- ** Positioned
             , Positioned, pos

             -- ** Selection
             , Checked, checked
             , CommandItems, items, appendItem, insertItem, removeItem, removeAllItems
             , SingleSelect, selected
             , MultiSelect, selection
             , RangedSelect, range, selectedPos
             
             -- ** Icon
             , HasIcon, icon

             -- * Internal
             , mapAttr
             , newAttr
             , newProp
             , varAttr
             , readAttr
             , writeAttr
             ) where

import Graphics.UI.GIO.Types

infixr 0 =:, =::
infixr 0 ~:, ~::

class ReadMode mode
class WriteMode mode

class Mode a

data Readable = Readable
data Writeable = Writeable

instance Mode Readable
instance Mode Writeable

instance ReadMode Readable
instance WriteMode Writeable

instance (Mode a,Mode b,ReadMode a) => ReadMode (a,b)
instance (Mode a,Mode b,WriteMode b) => WriteMode (a,b)

{--------------------------------------------------------------------
  Attributes
--------------------------------------------------------------------}
-- | Widgets @w@ can have attributes of type @a at . 
data Attr m w a = Attr (w -> IO a) (w -> a -> IO ())  

-- | Create a new attribute with a specified getter and setter function.
newAttr :: (w -> IO a) -> (w -> a -> IO ()) -> Attr (Readable,Writeable) w a
newAttr getter setter 
    = Attr getter setter

newProp :: (w -> IO ()) -> (w -> IO a) -> (w -> a -> IO ()) -> Prop w
newProp action getter setter
  = Prop action (\w -> do oldx <- getter w; return (setter w oldx))

-- | A property of a widget @w@ is an attribute that
-- is already associated with a value. Properties are
-- constructed with the '(=:)' operator.
data Prop w   = Prop{ propSet     :: (w -> IO ())
                    , propRestore :: (w -> IO (IO ()))  -- a function that returns a restoration function :-)
                    }


-- | (@mapAttr get set attr@) maps an attribute of @Attr w a@ to
-- @Attr w b@ where (@get :: a -> b@) is used when the attribute is
-- requested and (@set :: a -> b -> a@) is applied to current
-- value when the attribute is set.
mapAttr :: (ReadMode m,WriteMode m) => (a -> b) -> (a -> b -> a) -> Attr m w a -> Attr m w b
mapAttr get set (Attr getter setter)
    = Attr (\w   -> do a <- getter w; return (get a))
           (\w b -> do a <- getter w; setter w (set a b))


-- | Helper function to implement an attribute that just gets or sets a 'Var' member.
varAttr :: (w -> Var a) -> Attr (Readable,Writeable) w a
varAttr getvar
  = Attr (\w   -> getVar (getvar w))
         (\w x -> setVar (getvar w) x)


-- | Define a read-only attribute. Takes the name of the attribute as its first argument.
readAttr :: (w -> IO a) -> Attr Readable w a
readAttr getter
  = Attr getter undefined

-- | Define a write-only attribute. Takes the name of the attribute as its first argument.
writeAttr :: (w -> a -> IO ()) -> Attr Writeable w a
writeAttr setter
  = Attr undefined setter



-- | Set properties
set :: w -> [Prop w] -> IO ()
set w props
  = mapM_ (set1 w) props

set1 :: w -> Prop w -> IO ()
set1 w (Prop setter mkrestore) 
  = setter w

-- | Get an attribute
get :: ReadMode m => w -> Attr m w a -> IO a
get w (Attr getter setter)
  = getter w

-- | Set properties just for a certain computation. The previous values are automatically
-- restored on return.
with :: w -> [Prop w] -> IO a -> IO a
with w props io
  = foldr (with1 w) io props

with1 :: w -> Prop w -> IO a -> IO a
with1 w (Prop setter mkrestore) io
  = do restore <- mkrestore w
       setter w 
       x <- io
       restore
       return x

-- | Associate an attribute with a new value into a property.
(=:) :: WriteMode m => Attr m w a -> a -> Prop w
(=:) (Attr getter setter) x = newProp (\w -> setter w x) getter setter
          
-- | Apply an update function to an attribute.
(~:) :: (ReadMode m,WriteMode m) => Attr m w a -> (a -> a) -> Prop w
(~:) (Attr getter setter) f = newProp (\w -> do x <- getter w; setter w (f x)) getter setter

-- | Set the value of an attribute with a function that takes the widget
-- itself as an argument.
(=::) :: (ReadMode m,WriteMode m) => Attr m w a -> (w -> a) -> Prop w
(=::) (Attr getter setter) f = newProp (\w -> setter w (f w)) getter setter
          
-- | Set the value of an attribute with a function that takes the widget
-- itself and the current value of the attribute as arguments. 
(~::) :: (ReadMode m,WriteMode m) => Attr m w a -> (w -> a -> a) -> Prop w
(~::) (Attr getter setter) f = newProp (\w -> do x <- getter w; setter w (f w x)) getter setter

{--------------------------------------------------------------------
  Classes
--------------------------------------------------------------------}
 
-- | Widgets with dimensions have a width, height and position. Only the
-- 'frame' method is not defaulted.
class Dimensions w where
  -- | The outer frame of a widget.
  frame    :: (ReadMode m,WriteMode m) => Attr m w Rect
  
  -- | The upper-left corner.
  position :: (ReadMode m,WriteMode m) => Attr m w Point
  position  = mapAttr (\f -> topLeft f) (\f p -> rectMoveTo p f) frame

  -- | The size.
  size     :: (ReadMode m,WriteMode m) => Attr m w Size
  size      = mapAttr (\f -> rectSize f) (\f sz -> rectStretchTo sz f) frame
  
  -- | The width.
  width    :: (ReadMode m,WriteMode m) => Attr m w Int
  width     = mapAttr (\(Size w h) -> w) (\(Size _ h) w -> Size w h) size

  -- | The height.
  height   :: (ReadMode m,WriteMode m) => Attr m w Int
  height    = mapAttr (\(Size w h) -> h) (\(Size w _) h -> Size w h) size

-- | Widgets with a font.
class HasFont w where
  -- | The font.
  font :: (ReadMode m,WriteMode m) => Attr m w Font

class HasFont w => Drawn w where

  -- | The buffering mode. If the window is buffered then all
  -- drawing operations are first performed to memory buffer and after
  -- that the buffer is copied to the output device.
  bufferMode :: (ReadMode m,WriteMode m) => Attr m w BufferMode

  -- | The pen
  pen :: (ReadMode m,WriteMode m) => Attr m w Pen
  
  -- | The (fore ground) color of the widget.
  color :: (ReadMode m,WriteMode m) => Attr m w Color
  color = mapAttr penColor (\pen c -> pen{penColor=c}) pen
  
  -- | The back ground color.
  bgcolor :: (ReadMode m,WriteMode m) => Attr m w Color
  bgcolor = mapAttr penBackColor (\pen c -> pen{penBackColor=c}) pen

  -- | The hatch style.
  hatch :: (ReadMode m,WriteMode m) => Attr m w HatchStyle
  hatch = mapAttr penHatchStyle (\pen h -> pen{penHatchStyle=h}) pen

  -- | The thickness of the drawing pencil.
  thickness :: (ReadMode m,WriteMode m) => Attr m w Int
  thickness = mapAttr penSize (\pen n -> pen{penSize=n}) pen

  -- | The cap style.
  capstyle :: (ReadMode m,WriteMode m) => Attr m w CapStyle
  capstyle = mapAttr penCapStyle (\pen s -> pen{penCapStyle=s}) pen
  
  -- | The line style.
  linestyle :: (ReadMode m,WriteMode m) => Attr m w LineStyle
  linestyle = mapAttr penLineStyle (\pen s -> pen{penLineStyle=s}) pen
  
  -- | The join style.
  joinstyle :: (ReadMode m,WriteMode m) => Attr m w JoinStyle
  joinstyle = mapAttr penJoinStyle (\pen s -> pen{penJoinStyle=s}) pen
  
  drawMode :: (ReadMode m,WriteMode m) => Attr m w DrawMode
  drawMode = mapAttr penMode (\pen m -> pen{penMode=m}) pen
  
  bkDrawMode :: (ReadMode m,WriteMode m) => Attr m w Bool
  bkDrawMode = mapAttr penBkDrawMode (\pen m -> pen{penBkDrawMode=m}) pen


-- | Widgets with a title.
class Titled w m | w -> m where
  -- | The title.
  title :: Attr m w String

-- | Widgets that can be enabled or disabled.
class Able w where
  -- | Enable, or disable, the widget.
  enabled :: (ReadMode m,WriteMode m) => Attr m w Bool
  
-- | Widgets that supports tooltips.
class ToolTip w where
  -- | The tip text
  tooltip :: (ReadMode m,WriteMode m) => Attr m w String

-- | Widgets that has accelerator key.
class Accelerated w where
  -- | The accelerator. Set the property to (@KeyNull@) to remove the accelerator key.
  accel :: (ReadMode m,WriteMode m) => Attr m w Key
  
-- | Widgets that has specified integer position.
class Positioned w m | w -> m where
  -- | The widget position
  pos :: Attr m w Int

-- | Widgets that can be checked.
class Checked w where
  -- | Check the widget
  checked :: (ReadMode m,WriteMode m) => Attr m w Bool

-- | Widgets that have selectable items, like popup controls.
class CommandItems w where
  items :: (ReadMode m,WriteMode m) => Attr m w [(String,IO ())]
  appendItem :: w -> (String,IO ()) -> IO ()
  insertItem :: w -> Int -> (String,IO ()) -> IO ()
  removeItem :: w -> Int -> IO ()
  removeAllItems :: w -> IO ()
  
-- | Widgets that have a single selection (like radio control groups).
class SingleSelect w where
  selected  :: (ReadMode m,WriteMode m) => Attr m w Int

-- | Widgets with a multiple selection (like check box groups).
class MultiSelect w where
  selection :: (ReadMode m,WriteMode m) => Attr m w [Int]

-- | Widgets that selects integer position inside the specified range.
class RangedSelect w where
  -- | The selection range
  range :: (ReadMode m,WriteMode m) => Attr m w (Int, Int)
  
  -- | The selected position
  selectedPos :: (ReadMode m,WriteMode m) => Attr m w Int

-- | Widgets which displays an icon.
class HasIcon w where
  icon :: (ReadMode m,WriteMode m) => Attr m w (Maybe Bitmap)
-------------- next part --------------
-----------------------------------------------------------------------------------------
{-| Module      :  Bitmap
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2_mail at yahoo.com
    Stability   :  provisional
    Portability :  portable

    Bitmaps
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.GIO.Bitmap
            ( 
            -- * Bitmaps
              createBitmap
            , readBitmap, writeBitmap
            , getAvailableCodecs
            ) where


import qualified Graphics.UI.Port as Lib
import Graphics.UI.GIO.Types
import Graphics.UI.GIO.Attributes


{--------------------------------------------------------------------
  Bitmaps
--------------------------------------------------------------------}

-- | Create an empty bitmap of a certain size.
createBitmap :: Size -> IO Bitmap
createBitmap = Lib.createBitmap

-- | Read a bitmap from file.
readBitmap :: FilePath -> [Prop Bitmap] -> IO Bitmap
readBitmap fname props
  = do b <- Lib.readBitmap fname
       set b props
       return b
       
-- | Write a bitmap image to file. Can select different formats with the supplied MIME
-- string. The image type \"image\/bmp\" is always supported. See also 'getAvailableCodecs'.
writeBitmap :: Bitmap -> FilePath -> String -> IO ()
writeBitmap = Lib.writeBitmap

-- | Return all available codec's on this platform. 	
getAvailableCodecs :: IO [Codec]
getAvailableCodecs = Lib.getAvailableCodecs

instance Dimensions Bitmap where
  frame   = newAttr (\b -> do sz <- Lib.getBitmapSize b; return (rectOfSize sz))
                    (\b r -> do Lib.setBitmapSize b (rectSize r))