[Haskell-cafe] Re: Read Instance code.

Andy Stewart lazycat.manatee at gmail.com
Sat Jul 3 08:24:45 EDT 2010


Andy Stewart <lazycat.manatee at gmail.com> writes:

> Ivan Lazar Miljenovic <ivan.miljenovic at gmail.com> writes:
>
>> Andy Stewart <lazycat.manatee at gmail.com> writes:
>>
>>> Hi all,
>>>
>>> I have some incorrect "Read instance" make i got error "Prelude.read: no
>>> parse", and i don't know how to fix it. 
>>>
>>>
>>> newtype SerializedWindow = SerializedWindow (Maybe DrawWindow)
>>>     
>>> instance Show SerializedWindow where    
>>>   show _ = "SerializedWindow Nothing"
>>>            
>>> instance Read SerializedWindow where           
>>>     readsPrec _ str = [(SerializedWindow Nothing, idStr) 
>>>                            | (val :: String, idStr) <- reads str]
>>
>> Try using Derive or DrIFT to generate a proto-typical instance for you,
>> and then hack that and make it neater.  If you don't care about
>> cross-compiler compatability, using ReadP rather than ReadS also results
>> in nicer parsing code.
No matter, i found better way: 
Just skip ForeginPtr value when i do
Show, then i use "SerializedWindow Nothing" fill in Read instance.

  -- Andy


> Sorry, i haven't explain my situation.
>
> I'm try to serialized/derserialized Gtk+ Event C struct over the network.
>
> Since DrawWindow is ForeignPtr to point C structure, and "deriving Read"
> nothing help.
>
> So i want build a "bogus value" -- "SerializedWindow Nothing" to fill
> DrawWindow pointer field. 
>
> I just want got "SerializedWindow Nothing" and don't care the value
> that return by *reads*.
>
> Below are C struct that i want to serialized with Haskell data-type:
> typedef struct {
>   GdkEventType type;
>   GdkWindow *window;
>   gint8 send_event;
>   guint32 time;
>   guint state;
>   guint keyval;
>   gint length;
>   gchar *string;
>   guint16 hardware_keycode;
>   guint8 group;
>   guint is_modifier : 1;
> } GdkEventKey;
>
> Below are my C binding that explain my purpose:
>
> {-# LANGUAGE ScopedTypeVariables #-}
> -- -*-haskell-*-
>
> #include <gtk/gtk.h>
> #include "template-hsc-gtk2hs.h"
>
> --  GIMP Toolkit (GTK) GDK Serializabled Event
> --
> --  Author : Andy Stewart
> --
> --  Created: 01 Jul 2010
> --
> --  Copyright (C) 2010 Andy Stewart
> --
> --  This library is free software; you can redistribute it and/or
> --  modify it under the terms of the GNU Lesser General Public
> --  License as published by the Free Software Foundation; either
> --  version 2.1 of the License, or (at your option) any later version.
> --
> --  This library is distributed in the hope that it will be useful,
> --  but WITHOUT ANY WARRANTY; without even the implied warranty of
> --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
> --  Lesser General Public License for more details.
> --
> -- |
> -- Maintainer  : gtk2hs-users\@lists.sourceforge.net
> -- Stability   : deprecated
> -- Portability : portable (depends on GHC)
> --
> module Graphics.UI.Gtk.Gdk.SerializedEvent (
> -- * Types                                            
>     SerializedEventKey (..),
>     
> -- * Methods    
>     serializedEvent,
>     deserializeEventKey,                   
> ) where
>   
> import Control.Monad.Reader (ReaderT, ask, runReaderT )
> import Control.Monad.Trans (liftIO)
> import Data.Maybe
> import Data.Ord
> import Graphics.UI.Gtk.Gdk.DrawWindow
> import Graphics.UI.Gtk.Gdk.EventM
> import Graphics.UI.Gtk.Gdk.Keys (KeyVal)
> import Graphics.UI.GtkInternals
> import System.Glib.FFI
> import System.Glib.Flags
>     
> data SerializedEventKey =   
>     SerializedEventKey {sEventType      :: Int
>                        ,sEventWindow    :: SerializedWindow
>                        ,sEventSent      :: Bool
>                        ,sEventTime      :: Word32
>                        ,sEventState     :: Int
>                        ,sEventKeyval    :: KeyVal
>                        ,sEventLength    :: Int
>                        ,sEventString    :: String
>                        ,sEventKeycode   :: Word16
>                        ,sEventGroup     :: Word8
>                        ,sEventIsModifier:: Int}
>     deriving (Show, Eq, Ord, Read)
>                        
> newtype SerializedWindow = SerializedWindow (Maybe DrawWindow)
>     
> instance Eq SerializedWindow where           
>   (==) _ _ = True
>          
> instance Ord SerializedWindow where         
>   compare _ _ = EQ
>            
> instance Show SerializedWindow where    
>   show _ = "SerializedWindow Nothing"
>            
> instance Read SerializedWindow where           
>     readsPrec _ str = [(SerializedWindow Nothing, idStr) 
>                            | (val :: String, idStr) <- reads str]
>                       
> instance Storable SerializedEventKey where
>     sizeOf _ = #{const sizeof (GdkEventKey)}
>     alignment _ = alignment (undefined:: #gtk2hs_type gint)
>     peek ptr = peekSerializedKey ptr
>     poke ptr event = pokeSerializedKey ptr event    
>
> serializedEvent :: EventM t SerializedEventKey
> serializedEvent = do
>   ptr <- ask
>   eType <- liftIO $ do
>     (typ::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr
>     return typ
>   case eType of
>      #{const GDK_KEY_PRESS}	-> serializedKey
>      #{const GDK_KEY_RELEASE}	-> serializedKey
>      ty                         -> error ("serializedEvent: haven't handle event type " ++ show ty)
>                 
> serializedKey :: EventM t SerializedEventKey
> serializedKey = do
>   ptr <- ask
>   liftIO $ peekSerializedKey ptr
>     
> peekSerializedKey ptr = do
>     (typ_         ::#gtk2hs_type GdkEventType)    <- #{peek GdkEventKey, type} ptr
>     (sent_        ::#gtk2hs_type gint8)           <- #{peek GdkEventKey, send_event} ptr
>     (time_        ::#gtk2hs_type guint32)         <- #{peek GdkEventKey, time} ptr
>     (state_       ::#gtk2hs_type guint)           <- #{peek GdkEventKey, state} ptr
>     (keyval_      ::#gtk2hs_type guint)           <- #{peek GdkEventKey, keyval} ptr
>     (length_      ::#gtk2hs_type gint)            <- #{peek GdkEventKey, length} ptr
>     (keycode_     ::#gtk2hs_type guint16)         <- #{peek GdkEventKey, hardware_keycode} ptr
>     (group_       ::#gtk2hs_type guint8)          <- #{peek GdkEventKey, group} ptr
>     -- (isModifier_  ::#gtk2hs_type guint)           <- #{peek GdkEventKey, is_modifier} ptr
>     return $ SerializedEventKey
>                {sEventType        = fromIntegral typ_
>                ,sEventWindow = SerializedWindow Nothing -- this field need synthesize at client side
>                ,sEventSent        = toBool sent_
>                ,sEventTime        = fromIntegral time_ -- this field need synthesize at client side
>                ,sEventState       = fromIntegral state_
>                ,sEventKeyval      = keyval_
>                ,sEventLength      = fromIntegral length_
>                ,sEventString      = "" -- this filed has deprecated and should never be used
>                ,sEventKeycode     = keycode_
>                ,sEventGroup       = group_
>                -- ,sEventIsModifier  = isModifier_
>                ,sEventIsModifier  = 0
>                }
>     
> pokeSerializedKey ptr (SerializedEventKey
>                        {sEventType        = typ_
>                        ,sEventWindow      = SerializedWindow window_
>                        ,sEventSent        = sent_
>                        ,sEventTime        = time_
>                        ,sEventState       = state_
>                        ,sEventKeyval      = keyval_
>                        ,sEventLength      = length_
>                        ,sEventString      = string_
>                        ,sEventKeycode     = keycode_
>                        ,sEventGroup       = group_
>                        ,sEventIsModifier  = isModifier_
>                        }) = do
>   #{poke GdkEventKey, type} ptr ((fromIntegral typ_) ::#gtk2hs_type GdkEventType)
>   case (fromMaybe (DrawWindow nullForeignPtr) window_) of
>     win_ -> withForeignPtr (unDrawWindow win_) $ \winPtr -> 
>                    #{poke GdkEventKey, window} ptr winPtr
>   #{poke GdkEventKey, send_event}       ptr ((fromBool sent_)           ::#gtk2hs_type gint8)
>   #{poke GdkEventKey, time}             ptr ((fromIntegral time_)       ::#gtk2hs_type guint32)
>   #{poke GdkEventKey, state}            ptr ((fromIntegral state_)      ::#gtk2hs_type guint)
>   #{poke GdkEventKey, keyval}           ptr (keyval_                    ::#gtk2hs_type guint)   
>   #{poke GdkEventKey, length}           ptr ((fromIntegral length_)     ::#gtk2hs_type gint)
>   #{poke GdkEventKey, hardware_keycode} ptr (keycode_                   ::#gtk2hs_type guint16)
>   #{poke GdkEventKey, group}            ptr (group_                     ::#gtk2hs_type guint8)
>   
> -- | Insert DrawWindow and TimeStamp field when deserialized SerializedEventKey.
> deserializeEventKey :: SerializedEventKey -> DrawWindow -> (EventM t a) -> IO a
> deserializeEventKey event drawWindow fun = do
>   -- We need use *client* value replace field of event.
>   let newEvent = event {sEventWindow    = SerializedWindow $ Just drawWindow
>                        ,sEventTime      = currentTime}
>   with newEvent $ \eventPtr -> runReaderT fun (castPtr eventPtr)
>
>   -- Andy



More information about the Haskell-Cafe mailing list