[Gtk2hs-commit] (main branch): Add an Eq instance for all objects.

[Axel S. <si...@co...>]

Sun Apr 26 11:31:52 EDT 2009  Axe...@en...
  * Add an Eq instance for all objects.
  This patch makes it possible to use == to compare two objects or, rather,
  their pointers. Since for one case an object is merely containing data
  and has its own Eq instance, it was necessary to add a 'noEq' flag to
  the type generator that, when given, prevents the generation of the
  deriving Eq clause. This patch fixes trac #1158.

    hunk ./gio/System/GIO/File.chs.pp 161
    +-- | Compare two file descriptors for equality. This test is also used to
    +--   implement the '(==)' function, that is, comparing two descriptions
    +--   will compare their content, not the pointers to the two structures.
    +--
    hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 152
    -        Just (model', source) -> return (treeModelEqual model model'),
    +        Just (model', source) -> return (toTreeModel model==toTreeModel model'),
    hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 158
    -          if not (treeModelEqual model model') then return False
    +          if toTreeModel model/=toTreeModel model' then return False
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 71
    --- | Compare two tree model for equality.
    +-- this function is not necessary anymore since the models can be compared
    +-- using equality ==
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 199
    -        Just (model', source) -> return (treeModelEqual model model'),
    +        Just (model', source) -> return (toTreeModel model==toTreeModel model'),
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 205
    -          if not (treeModelEqual model model') then return False
    +          if toTreeModel model/=toTreeModel model' then return False
    hunk ./tools/hierarchyGen/TypeGen.hs 17
    --- b) the GTK blah_get_type function.
    -type TypeQuery  = (String, (String, Maybe String))
    +-- b) the info on this type 'TypeInfo'.
    +type TypeQuery  = (String, TypeInfo)
    +
    +-- The information of on the type.
    +data TypeInfo = TypeInfo {
    +  tiQueryFunction :: String, -- the GTK blah_get_type function
    +  tiAlternateName :: Maybe String,
    +  tiNoEqualInst   :: Bool
    +  }
    +
    hunk ./tools/hierarchyGen/TypeGen.hs 62
    -  pFreshLine (ps { hierObjs=spec}) (dropWhile ((/=) '\n') rem'')
    +  pFreshLine (ps { hierObjs=spec}) (dropWhile ((/=) '\n') rem''')
    hunk ./tools/hierarchyGen/TypeGen.hs 69
    -    (name,specialQuery,rem') = case (dropWhile isBlank rem) of
    +    (eqInst,rem') = [_$_]
    +       let r = dropWhile isBlank rem in
    +       if "noEq" `isPrefixOf` r then (True, drop 4 r) else (False, r)
    +    (name,specialQuery,rem'') = case (dropWhile isBlank rem') of
    hunk ./tools/hierarchyGen/TypeGen.hs 78
    -	        (tyName, (tyName, (origCName, Just tyQuery)), r')
    -	    r -> (tyName, (tyName, (origCName, Nothing)), r)
    -      r -> (origHsName, (origHsName, (origCName, Nothing)), r)
    +	        (tyName, (tyName, TypeInfo origCName (Just tyQuery) eqInst), r')
    +	    r -> (tyName, (tyName, TypeInfo origCName Nothing eqInst), r)
    +      r -> (origHsName, (origHsName, TypeInfo origCName Nothing eqInst), r)
    hunk ./tools/hierarchyGen/TypeGen.hs 83
    -    (readTag, rem'') = case (dropWhile isBlank rem') of
    +    (readTag, rem''') = case (dropWhile isBlank rem'') of
    hunk ./tools/hierarchyGen/TypeGen.hs 227
    -         (Just (_, Just get_type_func)) -> get_type_func
    -	 (Just (cname, _)) -> tail $ c2u True cname++"_get_type").
    +         (Just TypeInfo { tiAlternateName = Just get_type_func }) ->
    +           get_type_func
    +	 (Just TypeInfo { tiQueryFunction = cname}) ->
    +	   tail $ c2u True cname++"_get_type").
    hunk ./tools/hierarchyGen/TypeGen.hs 261
    -        (Just (cname, _)) | stripPrefix cname == name -> ss name
    -                          | otherwise     -> ss cname.ss " as ".ss name
    +        (Just TypeInfo { tiQueryFunction = cname })
    +          | stripPrefix cname == name -> ss name
    +          | otherwise                 -> ss cname.ss " as ".ss name
    hunk ./tools/hierarchyGen/TypeGen.hs 265
    -	  	                  then drop (length prefix) s
    +		                  then drop (length prefix) s
    hunk ./tools/hierarchyGen/TypeGen.hs 268
    -  	).
    +	).
    hunk ./tools/hierarchyGen/TypeGen.hs 270
    +  (case lookup name table of
    +     (Just (TypeInfo { tiNoEqualInst = False })) -> ss " deriving (Eq,Ord)"
    +     _ -> id
    +     ).
    hunk ./tools/hierarchyGen/hierarchy.list 235
    +# Note on all the "as" clauses: the prefix G is unfortunate since it leads
    +# to two consecutive upper case letters which are not translated with an
    +# underscore each (e.g. GConf -> gconf, GtkHButtonBox -> gtk_hbutton_box).
    hunk ./tools/hierarchyGen/hierarchy.list 273
    -        GFile				as File, g_file_get_type if gio
    +        GFile				noEq as File, g_file_get_type if gio