Copyright | (c) Daan Leijen 2003, 2004 |
---|---|
License | wxWindows |
Maintainer | wxhaskell-devel@lists.sourceforge.net |
Stability | provisional |
Portability | portable |
Safe Haskell | None |
Language | Haskell98 |
Basic types and marshalling code for the wxWidgets C library.
- data Object a
- objectNull :: Object a
- objectIsNull :: Object a -> Bool
- objectCast :: Object a -> Object b
- objectIsManaged :: Object a -> Bool
- objectDelete :: WxObject a -> IO ()
- objectFromPtr :: Ptr a -> Object a
- managedObjectFromPtr :: Ptr (TWxObject a) -> IO (WxObject a)
- withObjectPtr :: Object a -> (Ptr a -> IO b) -> IO b
- withObjectRef :: String -> Object a -> (Ptr a -> IO b) -> IO b
- withObjectResult :: IO (Ptr a) -> IO (Object a)
- withManagedObjectResult :: IO (Ptr (TWxObject a)) -> IO (WxObject a)
- objectFinalize :: Object a -> IO ()
- objectNoFinalize :: Object a -> IO ()
- type Id = Int
- type Style = Int
- type EventId = Int
- fromBool :: Num a => Bool -> a
- toBool :: (Eq a, Num a) => a -> Bool
- type Point = Point2 Int
- data Num a => Point2 a = Point {}
- point :: Num a => a -> a -> Point2 a
- pt :: Num a => a -> a -> Point2 a
- pointFromVec :: Num a => Vector -> Point2 a
- pointFromSize :: Num a => Size -> Point2 a
- pointZero :: Num a => Point2 a
- pointNull :: Num a => Point2 a
- type Size = Size2D Int
- data Num a => Size2D a = Size {}
- sz :: Num a => a -> a -> Size2D a
- sizeFromPoint :: Num a => Point2 a -> Size2D a
- sizeFromVec :: Num a => Vector2 a -> Size2D a
- sizeZero :: Num a => Size2D a
- sizeNull :: Num a => Size2D a
- type Vector = Vector2 Int
- data Num a => Vector2 a = Vector {}
- vector :: Num a => a -> a -> Vector2 a
- vec :: Num a => a -> a -> Vector2 a
- vecFromPoint :: Num a => Point2 a -> Vector2 a
- vecFromSize :: Size -> Vector
- vecZero :: Num a => Vector2 a
- vecNull :: Num a => Vector2 a
- type Rect = Rect2D Int
- data Num a => Rect2D a = Rect {
- rectLeft :: !a
- rectTop :: !a
- rectWidth :: !a
- rectHeight :: !a
- rectTopLeft :: Num a => Rect2D a -> Point2 a
- rectTopRight :: Num a => Rect2D a -> Point2 a
- rectBottomLeft :: Num a => Rect2D a -> Point2 a
- rectBottomRight :: Num a => Rect2D a -> Point2 a
- rectBottom :: Num a => Rect2D a -> a
- rectRight :: Num a => Rect2D a -> a
- rect :: Num a => Point2 a -> Size2D a -> Rect2D a
- rectBetween :: (Num a, Ord a) => Point2 a -> Point2 a -> Rect2D a
- rectFromSize :: Num a => Size2D a -> Rect2D a
- rectZero :: Num a => Rect2D a
- rectNull :: Num a => Rect2D a
- rectSize :: Num a => Rect2D a -> Size2D a
- rectIsEmpty :: (Num a, Eq a) => Rect2D a -> Bool
- newtype Color = Color Word
- rgb :: Integral a => a -> a -> a -> Color
- colorRGB :: Integral a => a -> a -> a -> Color
- rgba :: Integral a => a -> a -> a -> a -> Color
- colorRGBA :: Integral a => a -> a -> a -> a -> Color
- colorRed :: Num a => Color -> a
- colorGreen :: Num a => Color -> a
- colorBlue :: Num a => Color -> a
- colorAlpha :: Num a => Color -> a
- intFromColor :: Color -> Int
- colorFromInt :: Int -> Color
- fromColor :: Num a => Color -> a
- toColor :: Integral a => a -> Color
- colorOk :: Color -> Bool
- colorIsOk :: Color -> Bool
- withPointResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO (Point2 Int)
- withWxPointResult :: IO (Ptr (TWxPoint a)) -> IO (Point2 Int)
- toCIntPointX :: Point2 Int -> CInt
- toCIntPointY :: Point2 Int -> CInt
- fromCPoint :: CInt -> CInt -> Point2 Int
- withCPoint :: Point2 Int -> (CInt -> CInt -> IO a) -> IO a
- withPointDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Point2 Double)
- toCDoublePointX :: Point2 Double -> CDouble
- toCDoublePointY :: Point2 Double -> CDouble
- fromCPointDouble :: CDouble -> CDouble -> Point2 Double
- withCPointDouble :: Point2 Double -> (CDouble -> CDouble -> IO a) -> IO a
- withSizeResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO Size
- withWxSizeResult :: IO (Ptr (TWxSize a)) -> IO Size
- toCIntSizeW :: Size -> CInt
- toCIntSizeH :: Size -> CInt
- fromCSize :: CInt -> CInt -> Size
- withCSize :: Size -> (CInt -> CInt -> IO a) -> IO a
- withSizeDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Size2D Double)
- toCDoubleSizeW :: Size2D Double -> CDouble
- toCDoubleSizeH :: Size2D Double -> CDouble
- fromCSizeDouble :: CDouble -> CDouble -> Size2D Double
- withCSizeDouble :: Size2D Double -> (CDouble -> CDouble -> IO a) -> IO a
- withVectorResult :: (Ptr CInt -> Ptr CInt -> IO ()) -> IO Vector
- withWxVectorResult :: IO (Ptr (TWxPoint a)) -> IO Vector
- toCIntVectorX :: Vector -> CInt
- toCIntVectorY :: Vector -> CInt
- fromCVector :: CInt -> CInt -> Vector
- withCVector :: Vector -> (CInt -> CInt -> IO a) -> IO a
- withVectorDoubleResult :: (Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Vector2 Double)
- toCDoubleVectorX :: Vector2 Double -> CDouble
- toCDoubleVectorY :: Vector2 Double -> CDouble
- fromCVectorDouble :: CDouble -> CDouble -> Vector2 Double
- withCVectorDouble :: Vector2 Double -> (CDouble -> CDouble -> IO a) -> IO a
- withRectResult :: (Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()) -> IO Rect
- withWxRectResult :: IO (Ptr (TWxRect a)) -> IO Rect
- withWxRectPtr :: Rect -> (Ptr (TWxRect r) -> IO a) -> IO a
- toCIntRectX :: Rect -> CInt
- toCIntRectY :: Rect -> CInt
- toCIntRectW :: Rect -> CInt
- toCIntRectH :: Rect -> CInt
- fromCRect :: CInt -> CInt -> CInt -> CInt -> Rect
- withCRect :: Rect -> (CInt -> CInt -> CInt -> CInt -> IO a) -> IO a
- withRectDoubleResult :: (Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Rect2D Double)
- toCDoubleRectX :: Rect2D Double -> CDouble
- toCDoubleRectY :: Rect2D Double -> CDouble
- toCDoubleRectW :: Rect2D Double -> CDouble
- toCDoubleRectH :: Rect2D Double -> CDouble
- fromCRectDouble :: CDouble -> CDouble -> CDouble -> CDouble -> Rect2D Double
- withCRectDouble :: Rect2D Double -> (CDouble -> CDouble -> CDouble -> CDouble -> IO a) -> IO a
- withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
- withArrayString :: [String] -> (CInt -> Ptr CString -> IO a) -> IO a
- withArrayWString :: [String] -> (CInt -> Ptr CWString -> IO a) -> IO a
- withArrayInt :: [Int] -> (CInt -> Ptr CInt -> IO a) -> IO a
- withArrayIntPtr :: [IntPtr] -> (CInt -> Ptr CIntPtr -> IO a) -> IO a
- withArrayObject :: [Ptr a] -> (CInt -> Ptr (Ptr a) -> IO b) -> IO b
- withArrayIntResult :: (Ptr CInt -> IO CInt) -> IO [Int]
- withArrayIntPtrResult :: (Ptr CIntPtr -> IO CInt) -> IO [IntPtr]
- withArrayStringResult :: (Ptr (Ptr CChar) -> IO CInt) -> IO [String]
- withArrayWStringResult :: (Ptr (Ptr CWchar) -> IO CInt) -> IO [String]
- withArrayObjectResult :: (Ptr (Ptr a) -> IO CInt) -> IO [Object a]
- colourFromColor :: Color -> IO (Colour ())
- colorFromColour :: Colour a -> IO Color
- colourCreate :: IO (Ptr (TColour a))
- colourSafeDelete :: Ptr (TColour a) -> IO ()
- data TreeItem
- treeItemInvalid :: TreeItem
- treeItemIsOk :: TreeItem -> Bool
- treeItemFromInt :: IntPtr -> TreeItem
- withRefTreeItemId :: (Ptr (TTreeItemId ()) -> IO ()) -> IO TreeItem
- withTreeItemIdPtr :: TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b
- withTreeItemIdRef :: String -> TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b
- withManagedTreeItemIdResult :: IO (Ptr (TTreeItemId a)) -> IO TreeItem
- withStringRef :: String -> String -> (Ptr (TWxString s) -> IO a) -> IO a
- withStringPtr :: String -> (Ptr (TWxString s) -> IO a) -> IO a
- withManagedStringResult :: IO (Ptr (TWxString a)) -> IO String
- withRefColour :: (Ptr (TColour a) -> IO ()) -> IO Color
- withColourRef :: String -> Color -> (Ptr (TColour a) -> IO b) -> IO b
- withColourPtr :: Color -> (Ptr (TColour a) -> IO b) -> IO b
- withManagedColourResult :: IO (Ptr (TColour a)) -> IO Color
- withRefBitmap :: (Ptr (TBitmap a) -> IO ()) -> IO (Bitmap a)
- withManagedBitmapResult :: IO (Ptr (TBitmap a)) -> IO (Bitmap a)
- withRefCursor :: (Ptr (TCursor a) -> IO ()) -> IO (Cursor a)
- withManagedCursorResult :: IO (Ptr (TCursor a)) -> IO (Cursor a)
- withRefIcon :: (Ptr (TIcon a) -> IO ()) -> IO (Icon a)
- withManagedIconResult :: IO (Ptr (TIcon a)) -> IO (Icon a)
- withRefPen :: (Ptr (TPen a) -> IO ()) -> IO (Pen a)
- withManagedPenResult :: IO (Ptr (TPen a)) -> IO (Pen a)
- withRefBrush :: (Ptr (TBrush a) -> IO ()) -> IO (Brush a)
- withManagedBrushResult :: IO (Ptr (TBrush a)) -> IO (Brush a)
- withRefFont :: (Ptr (TFont a) -> IO ()) -> IO (Font a)
- withManagedFontResult :: IO (Ptr (TFont a)) -> IO (Font a)
- withRefImage :: (Ptr (TImage a) -> IO ()) -> IO (Image a)
- withRefListItem :: (Ptr (TListItem a) -> IO ()) -> IO (ListItem a)
- withRefFontData :: (Ptr (TFontData a) -> IO ()) -> IO (FontData a)
- withRefPrintData :: (Ptr (TPrintData a) -> IO ()) -> IO (PrintData a)
- withRefPageSetupDialogData :: (Ptr (TPageSetupDialogData a) -> IO ()) -> IO (PageSetupDialogData a)
- withRefPrintDialogData :: (Ptr (TPrintDialogData a) -> IO ()) -> IO (PrintDialogData a)
- withRefDateTime :: (Ptr (TDateTime a) -> IO ()) -> IO (DateTime a)
- withManagedDateTimeResult :: IO (Ptr (TDateTime a)) -> IO (DateTime a)
- withRefGridCellCoordsArray :: (Ptr (TGridCellCoordsArray a) -> IO ()) -> IO (GridCellCoordsArray a)
- withManagedGridCellCoordsArrayResult :: IO (Ptr (TGridCellCoordsArray a)) -> IO (GridCellCoordsArray a)
- type CString = Ptr CChar
- withCString :: String -> (CString -> IO a) -> IO a
- withStringResult :: (Ptr CChar -> IO CInt) -> IO String
- type CWString = Ptr CWchar
- withCWString :: String -> (CWString -> IO a) -> IO a
- withWStringResult :: (Ptr CWchar -> IO CInt) -> IO String
- withByteStringResult :: (Ptr CChar -> IO CInt) -> IO ByteString
- withLazyByteStringResult :: (Ptr CChar -> IO CInt) -> IO ByteString
- newtype CInt :: * = CInt Int32
- toCInt :: Int -> CInt
- fromCInt :: CInt -> Int
- withIntResult :: IO CInt -> IO Int
- data IntPtr :: *
- data CIntPtr :: *
- toCIntPtr :: IntPtr -> CIntPtr
- fromCIntPtr :: CIntPtr -> IntPtr
- withIntPtrResult :: IO CIntPtr -> IO IntPtr
- data Word :: *
- data Word8 :: *
- data Int64 :: *
- newtype CDouble :: * = CDouble Double
- toCDouble :: Double -> CDouble
- fromCDouble :: CDouble -> Double
- withDoubleResult :: IO CDouble -> IO Double
- data CChar :: *
- toCChar :: Char -> CChar
- fromCChar :: CChar -> Char
- withCharResult :: (Num a, Integral a, Show a) => IO a -> IO Char
- newtype CWchar :: * = CWchar Int32
- toCWchar :: Num a => Char -> a
- type CBool = CInt
- toCBool :: Bool -> CBool
- fromCBool :: CBool -> Bool
- withBoolResult :: IO CBool -> IO Bool
- data Ptr a :: * -> *
- ptrNull :: Ptr a
- ptrIsNull :: Ptr a -> Bool
- ptrCast :: Ptr a -> Ptr b
- data ForeignPtr a :: * -> *
- data FunPtr a :: * -> *
- toCFunPtr :: FunPtr a -> Ptr a
Object types
An Object a
is a pointer to an object of type a
. The a
parameter is used
to encode the inheritance relation. When the type parameter is unit ()
, it denotes
an object of exactly that class, when the parameter is a type variable a
, it
specifies an object that is at least an instance of that class. For example in
wxWidgets, we have the following class hierarchy:
EvtHandler |- Window |- Frame |- Control |- Button |- Radiobox
In wxHaskell, all the creation functions will return objects of exactly that
class and use the ()
type:
frameCreate :: Window a -> ... -> IO (Frame ()) buttonCreate :: Window a -> ... -> IO (Button ()) ...
In contrast, all the this (or self) pointers of methods can take objects of any instance of that class and have a type variable, for example:
windowSetClientSize :: Window a -> Size -> IO () controlSetLabel :: Control a -> String -> IO () buttonSetDefault :: Button a -> IO ()
This means that we can use windowSetClientSize
on any window, including
buttons and frames, but we can only use controlSetLabel
on controls, not
including frames.
In wxHaskell, this works since a Frame ()
is actually a type synonym for
Window (CFrame ())
(where CFrame
is an abstract data type). We can thus
pass a value of type Frame ()
to anything that expects some Window a
.
For a button this works too, as it is a synonym for Control (CButton ())
which is in turn a synonym for Window (CControl (CButton ()))
. Note that
we can't pass a frame to something that expects a value of type Control a
.
Of course, a Window a
is actually a type synonym for EvtHandler (CWindow a)
.
If you study the documentation in Graphics.UI.WX.Classes closely, you
can discover where this chain ends :-).
Objects are not automatically deleted. Normally you can use a delete function
like windowDelete
to delete an object. However, almost all objects in the
wxWidgets library are automatically deleted by the library. The only objects
that should be used with care are resources as bitmaps, fonts and brushes.
objectNull :: Object a Source
A null object. Use with care.
objectIsNull :: Object a -> Bool Source
Test for null object.
objectCast :: Object a -> Object b Source
Cast an object to another type. Use with care.
objectIsManaged :: Object a -> Bool Source
Is this a managed object?
objectDelete :: WxObject a -> IO () Source
Delete a wxObject, works for managed and unmanaged objects.
objectFromPtr :: Ptr a -> Object a Source
Create an unmanaged object.
managedObjectFromPtr :: Ptr (TWxObject a) -> IO (WxObject a) Source
Create a managed object that will be deleted using |wxObject_SafeDelete|.
withObjectRef :: String -> Object a -> (Ptr a -> IO b) -> IO b Source
Extract the object pointer and raise an exception if NULL
.
Otherwise continue with the valid pointer.
withManagedObjectResult :: IO (Ptr (TWxObject a)) -> IO (WxObject a) Source
Create a managed object that will be deleted using |wxObject_SafeDelete|.
objectFinalize :: Object a -> IO () Source
Finalize a managed object manually. (No effect on unmanaged objects.)
objectNoFinalize :: Object a -> IO () Source
Remove the finalizer on a managed object. (No effect on unmanaged objects.)
Type synonyms
Basic types
Point
A point has an x and y coordinate. Coordinates are normally relative to the upper-left corner of their view frame, where a positive x goes to the right and a positive y to the bottom of the view.
pointFromVec :: Num a => Vector -> Point2 a Source
pointFromSize :: Num a => Size -> Point2 a Source
pointNull :: Num a => Point2 a Source
A null
point is not a legal point (x and y are -1) and can be used for some
wxWidgets functions to select a default point.
Size
A Size
has a width and height.
sizeFromPoint :: Num a => Point2 a -> Size2D a Source
sizeFromVec :: Num a => Vector2 a -> Size2D a Source
sizeNull :: Num a => Size2D a Source
A null
size is not a legal size (width and height are -1) and can be used for some
wxWidgets functions to select a default size.
Vector
vecFromPoint :: Num a => Point2 a -> Vector2 a Source
vecFromSize :: Size -> Vector Source
vecNull :: Num a => Vector2 a Source
A null
vector has a delta x and y of -1 and can be used for some
wxWidgets functions to select a default vector.
Rectangle
A rectangle is defined by the left x coordinate, the top y coordinate, the width and the height.
Rect | |
|
rectTopLeft :: Num a => Rect2D a -> Point2 a Source
rectTopRight :: Num a => Rect2D a -> Point2 a Source
rectBottomLeft :: Num a => Rect2D a -> Point2 a Source
rectBottomRight :: Num a => Rect2D a -> Point2 a Source
rectBottom :: Num a => Rect2D a -> a Source
rect :: Num a => Point2 a -> Size2D a -> Rect2D a Source
Create a rectangle at a certain (upper-left) point with a certain size.
rectBetween :: (Num a, Ord a) => Point2 a -> Point2 a -> Rect2D a Source
Construct a (positive) rectangle between two (arbitrary) points.
rectFromSize :: Num a => Size2D a -> Rect2D a Source
Create a rectangle of a certain size with the upper-left corner at (pt
0 0).
rectNull :: Num a => Rect2D a Source
An null
rectangle is not a valid rectangle (Rect -1 -1 -1 -1
) but can
used for some wxWidgets functions to select a default rectangle. (i.e. frameCreate
).
Color
An abstract data type to define colors.
Note: Haddock 0.8 and 0.9 doesn't support GeneralizedNewtypeDeriving. So, This class
doesn't have IArray
class's unboxed array instance now. If you want to use this type
with unboxed array, you must write code like this.
{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses #-} import Graphics.UI.WXCore.WxcTypes ... deriving instance IArray UArray Color
We can't derive MArray
class's unboxed array instance this way. This is a bad point
of current MArray
class definition.
rgba :: Integral a => a -> a -> a -> a -> Color Source
Create a color from a red/green/blue/alpha quadruple.
colorRGBA :: Integral a => a -> a -> a -> a -> Color Source
Create a color from a red/green/blue/alpha quadruple.
colorGreen :: Num a => Color -> a Source
Returns a green color component
colorAlpha :: Num a => Color -> a Source
Returns a alpha channel component
intFromColor :: Color -> Int Source
Return an Int
where the three least significant bytes contain
the red, green, and blue component of a color.
colorFromInt :: Int -> Color Source
Set the color according to an rgb integer. (see rgbIntFromColor
).
fromColor :: Num a => Color -> a Source
Return an Num
class's numeric representation where the three
least significant the red, green, and blue component of a color.
toColor :: Integral a => a -> Color Source
Set the color according to Integral
class's numeric representation.
(see rgbaIntFromColor
).
Marshalling
Basic types
toCIntPointX :: Point2 Int -> CInt Source
toCIntPointY :: Point2 Int -> CInt Source
toCDoublePointX :: Point2 Double -> CDouble Source
toCDoublePointY :: Point2 Double -> CDouble Source
toCIntSizeW :: Size -> CInt Source
toCIntSizeH :: Size -> CInt Source
toCDoubleSizeW :: Size2D Double -> CDouble Source
toCDoubleSizeH :: Size2D Double -> CDouble Source
toCIntVectorX :: Vector -> CInt Source
toCIntVectorY :: Vector -> CInt Source
fromCVector :: CInt -> CInt -> Vector Source
toCIntRectX :: Rect -> CInt Source
toCIntRectY :: Rect -> CInt Source
toCIntRectW :: Rect -> CInt Source
toCIntRectH :: Rect -> CInt Source
withRectDoubleResult :: (Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()) -> IO (Rect2D Double) Source
toCDoubleRectX :: Rect2D Double -> CDouble Source
toCDoubleRectY :: Rect2D Double -> CDouble Source
toCDoubleRectW :: Rect2D Double -> CDouble Source
toCDoubleRectH :: Rect2D Double -> CDouble Source
withCRectDouble :: Rect2D Double -> (CDouble -> CDouble -> CDouble -> CDouble -> IO a) -> IO a Source
withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
Temporarily store a list of storable values in memory
(like with
, but for multiple elements).
colourFromColor :: Color -> IO (Colour ()) Source
colorFromColour :: Colour a -> IO Color Source
colourCreate :: IO (Ptr (TColour a)) Source
colourSafeDelete :: Ptr (TColour a) -> IO () Source
Managed object types
Identifies tree items. Note: Replaces the TreeItemId
object and takes automatically
care of allocation issues.
treeItemInvalid :: TreeItem Source
Invalid tree item.
treeItemIsOk :: TreeItem -> Bool Source
Is a tree item ok? (i.e. not invalid).
treeItemFromInt :: IntPtr -> TreeItem Source
withRefTreeItemId :: (Ptr (TTreeItemId ()) -> IO ()) -> IO TreeItem Source
withTreeItemIdPtr :: TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b Source
withTreeItemIdRef :: String -> TreeItem -> (Ptr (TTreeItemId a) -> IO b) -> IO b Source
withManagedTreeItemIdResult :: IO (Ptr (TTreeItemId a)) -> IO TreeItem Source
withRefPrintData :: (Ptr (TPrintData a) -> IO ()) -> IO (PrintData a) Source
withRefPageSetupDialogData :: (Ptr (TPageSetupDialogData a) -> IO ()) -> IO (PageSetupDialogData a) Source
withRefPrintDialogData :: (Ptr (TPrintDialogData a) -> IO ()) -> IO (PrintDialogData a) Source
withRefGridCellCoordsArray :: (Ptr (TGridCellCoordsArray a) -> IO ()) -> IO (GridCellCoordsArray a) Source
withManagedGridCellCoordsArrayResult :: IO (Ptr (TGridCellCoordsArray a)) -> IO (GridCellCoordsArray a) Source
Primitive types
CString
withCString :: String -> (CString -> IO a) -> IO a
Marshal a Haskell string into a NUL terminated C string using temporary storage.
- the Haskell string may not contain any NUL characters
- the memory is freed when the subcomputation terminates (either normally or via an exception), so the pointer to the temporary storage must not be used after this.
A C wide string is a reference to an array of C wide characters terminated by NUL.
withCWString :: String -> (CWString -> IO a) -> IO a
Marshal a Haskell string into a NUL terminated C wide string using temporary storage.
- the Haskell string may not contain any NUL characters
- the memory is freed when the subcomputation terminates (either normally or via an exception), so the pointer to the temporary storage must not be used after this.
ByteString
withByteStringResult :: (Ptr CChar -> IO CInt) -> IO ByteString Source
withLazyByteStringResult :: (Ptr CChar -> IO CInt) -> IO ByteString Source
CInt
newtype CInt :: *
Haskell type representing the C int
type.
IntPtr
data IntPtr :: *
A signed integral type that can be losslessly converted to and from
Ptr
. This type is also compatible with the C99 type intptr_t
, and
can be marshalled to and from that type safely.
CIntPtr
data CIntPtr :: *
fromCIntPtr :: CIntPtr -> IntPtr Source
Word
data Word :: *
8 bit Word
data Word8 :: *
8-bit unsigned integer type
64 bit Integer
data Int64 :: *
64-bit signed integer type
CDouble
newtype CDouble :: *
Haskell type representing the C double
type.
fromCDouble :: CDouble -> Double Source
CChar
data CChar :: *
Haskell type representing the C char
type.
newtype CWchar :: *
Haskell type representing the C wchar_t
type.
CBool
Pointers
data Ptr a :: * -> *
A value of type
represents a pointer to an object, or an
array of objects, which may be marshalled to or from Haskell values
of type Ptr
aa
.
The type a
will often be an instance of class
Storable
which provides the marshalling operations.
However this is not essential, and you can provide your own operations
to access the pointer. For example you might write small foreign
functions to get or set the fields of a C struct
.
data ForeignPtr a :: * -> *
The type ForeignPtr
represents references to objects that are
maintained in a foreign language, i.e., that are not part of the
data structures usually managed by the Haskell storage manager.
The essential difference between ForeignPtr
s and vanilla memory
references of type Ptr a
is that the former may be associated
with finalizers. A finalizer is a routine that is invoked when
the Haskell storage manager detects that - within the Haskell heap
and stack - there are no more references left that are pointing to
the ForeignPtr
. Typically, the finalizer will, then, invoke
routines in the foreign language that free the resources bound by
the foreign object.
The ForeignPtr
is parameterised in the same way as Ptr
. The
type argument of ForeignPtr
should normally be an instance of
class Storable
.
Eq (ForeignPtr a) | |
Ord (ForeignPtr a) | |
Show (ForeignPtr a) |
data FunPtr a :: * -> *
A value of type
is a pointer to a function callable
from foreign code. The type FunPtr
aa
will normally be a foreign type,
a function type with zero or more arguments where
- the argument types are marshallable foreign types,
i.e.
Char
,Int
,Double
,Float
,Bool
,Int8
,Int16
,Int32
,Int64
,Word8
,Word16
,Word32
,Word64
,
,Ptr
a
,FunPtr
a
or a renaming of any of these usingStablePtr
anewtype
. - the return type is either a marshallable foreign type or has the form
whereIO
tt
is a marshallable foreign type or()
.
A value of type
may be a pointer to a foreign function,
either returned by another foreign function or imported with a
a static address import likeFunPtr
a
foreign import ccall "stdlib.h &free" p_free :: FunPtr (Ptr a -> IO ())
or a pointer to a Haskell function created using a wrapper stub
declared to produce a FunPtr
of the correct type. For example:
type Compare = Int -> Int -> Bool foreign import ccall "wrapper" mkCompare :: Compare -> IO (FunPtr Compare)
Calls to wrapper stubs like mkCompare
allocate storage, which
should be released with freeHaskellFunPtr
when no
longer required.
To convert FunPtr
values to corresponding Haskell functions, one
can define a dynamic stub for the specific foreign type, e.g.
type IntFunction = CInt -> IO () foreign import ccall "dynamic" mkFun :: FunPtr IntFunction -> IntFunction