hayland 0.1.0.0 → 0.1.0.1
raw patch · 4 files changed
+101/−53 lines, 4 files
Files
- Graphics/Wayland/Scanner/Marshaller.chs +45/−4
- Graphics/Wayland/Scanner/Types.chs +55/−0
- Graphics/Wayland/Scanner/Types.hs +0/−48
- hayland.cabal +1/−1
Graphics/Wayland/Scanner/Marshaller.chs view
@@ -7,6 +7,7 @@ funcSize, funcAlign ) where +import Control.Exception.Base (bracket) import Data.Functor import Data.Fixed (Fixed(..)) import Foreign@@ -32,6 +33,8 @@ fixed256ToWlFixed :: Fixed256 -> CInt fixed256ToWlFixed (MkFixed a) = fromIntegral a +-- {#pointer * array as WLArray nocode#}+ argTypeToCType :: Argument -> TypeQ argTypeToCType (_,IntArg,_) = [t| {#type int32_t#} |] argTypeToCType (_,UIntArg,_) = [t| {#type uint32_t#} |]@@ -39,7 +42,7 @@ argTypeToCType (_,StringArg,_) = [t| Ptr CChar |] argTypeToCType (_,(ObjectArg iname),_) = return $ ConT iname argTypeToCType (_,(NewIdArg iname _),_) = return $ ConT iname-argTypeToCType (_,ArrayArg,_) = undefined+argTypeToCType (_,ArrayArg,_) = [t|WLArray|] argTypeToCType (_,FdArg,_) = [t| {#type int32_t#} |] argTypeToHaskType :: Argument -> TypeQ@@ -54,7 +57,8 @@ argTypeToHaskType (_,StringArg,True) = [t|Maybe String|] argTypeToHaskType (_,(ObjectArg iname),True) = [t|Maybe $(conT iname) |] argTypeToHaskType (_,(NewIdArg iname _),True) = [t|Maybe $(conT iname) |]-argTypeToHaskType (_,ArrayArg,_) = undefined+argTypeToHaskType (_,ArrayArg,True) = [t|Maybe (Int, Ptr ())|] -- size_t size and void*+argTypeToHaskType (_,ArrayArg,False) = [t|(Int, Ptr ())|] -- size_t size and void* argTypeToHaskType (_,FdArg,_) = [t|Fd|] argTypeToWeirdInterfaceCType :: Argument -> TypeQ@@ -93,7 +97,32 @@ Nothing -> $(applyMarshaller as [|$fun ($(conE iname) nullPtr)|]) Just obj -> $(applyMarshaller as [|$fun obj|]) |]- applyMarshaller (arg@(_, ArrayArg, _):as) fun = undefined+ applyMarshaller (arg@(_, ArrayArg, True):as) fun = [|+ case $(mk arg) of+ Nothing -> $(applyMarshaller as [|$fun nullPtr|])+ Just (size, dat) -> bracket+ (mallocBytes (2*{#sizeof size_t#}+ 4)) -- FIXME prettify / make portable. is this even right?+ (free)+ (\arrayPtr -> do+ {#set array.size#} arrayPtr size+ {#set array.alloc#} arrayPtr size -- FIXME or should we force powers of 2?+ {#set array.data#} arrayPtr dat+ $(applyMarshaller as [|$fun arrayPtr|])+ )+ |]+ applyMarshaller (arg@(_, ArrayArg, False):as) fun = [|+ do+ let (size, dat) = $(mk arg)+ bracket+ (mallocBytes (2*{#sizeof size_t#}+ 4)) -- FIXME prettify / make portable. is this even right?+ (free)+ (\arrayPtr -> do+ {#set array.size#} arrayPtr size+ {#set array.alloc#} arrayPtr size -- FIXME or should we force powers of 2?+ {#set array.data#} arrayPtr dat+ $(applyMarshaller as [|$fun arrayPtr|])+ )+ |] applyMarshaller (arg@(_, FdArg, _):as) fun = [|$(applyMarshaller as [|$fun (unFd ($(mk arg)))|]) |] applyMarshaller [] fun = fun in (map VarP vars, applyMarshaller args fun)@@ -129,7 +158,19 @@ if $(mk arg) == nullPtr then Nothing else Just $ $(conE iname) $(mk arg)|]) |]- applyUnmarshaller (arg@(_, ArrayArg, _):as) fun = undefined+ applyUnmarshaller (arg@(_, ArrayArg, True):as) fun = [|+ if $(mk arg) == nullPtr+ then $(applyUnmarshaller as [|$fun Nothing|])+ else do+ size <- fromIntegral <$> {#get array->size#} ($(mk arg) :: WLArray)+ dat <- {#get array->data#} ($(mk arg) :: WLArray)+ $(applyUnmarshaller as [|$fun (Just (size, dat)) |])+ |]+ applyUnmarshaller (arg@(_, ArrayArg, False):as) fun = [|do+ size <- fromIntegral <$> {#get array->size#} ($(mk arg) :: WLArray)+ dat <- {#get array->data#} ($(mk arg) :: WLArray)+ $(applyUnmarshaller as [|$fun (size, dat) |])+ |] applyUnmarshaller (arg@(_, FdArg, _):as) fun = [|$(applyUnmarshaller as [|$fun (Fd ($(mk arg)))|]) |] applyUnmarshaller [] fun = fun in (map VarP vars, applyUnmarshaller args fun)
+ Graphics/Wayland/Scanner/Types.chs view
@@ -0,0 +1,55 @@+module Graphics.Wayland.Scanner.Types where++import Foreign+import Language.Haskell.TH (Name)++#include <wayland-util.h>++{#context prefix="wl"#}++data ServerClient = Server | Client deriving (Eq)++-- | wayland-style interface name (e.g. wl_display)+type InterfaceName = String+data Interface = Interface {+ interfaceName :: InterfaceName,+ interfaceVersion :: Int,+ interfaceRequests :: [Message], -- ^ aka requests+ interfaceEvents :: [Message],+ interfaceEnums :: [WLEnum]+ } deriving (Show)++type EnumName = String+-- | wayland style enum specification (not Prelude)+data WLEnum = WLEnum {+ enumName :: EnumName,+ enumEntries :: [(String,Int)]+ } deriving (Show)++-- | wayland wire protocol argument type. we can't deal with untyped object/new-id arguments.+data ArgumentType = IntArg | UIntArg | FixedArg | StringArg | ObjectArg Name | NewIdArg Name MessageName | ArrayArg | FdArg deriving (Show)+argConversionTable :: [(String, ArgumentType)] -- for all easy argument types+argConversionTable = [+ ("int", IntArg),+ ("uint", UIntArg),+ ("fixed", FixedArg),+ ("string", StringArg),+ ("fd", FdArg),+ ("array", ArrayArg)]++type Argument = (String, ArgumentType, Bool) -- name, argument type, allow-null++type MessageName = String+data Message = Message {+ messageName :: MessageName,+ messageArguments :: [Argument],+ messageIsDestructor :: Bool+ } deriving (Show)++type ProtocolName = String+data ProtocolSpec = ProtocolSpec {+ protocolName :: ProtocolName,+ protocolInterfaces :: [Interface]+ } deriving (Show)++{#pointer * array as WLArray#}
− Graphics/Wayland/Scanner/Types.hs
@@ -1,48 +0,0 @@-module Graphics.Wayland.Scanner.Types where--import Language.Haskell.TH (Name)---data ServerClient = Server | Client deriving (Eq)---- | wayland-style interface name (e.g. wl_display)-type InterfaceName = String-data Interface = Interface {- interfaceName :: InterfaceName,- interfaceVersion :: Int,- interfaceRequests :: [Message], -- ^ aka requests- interfaceEvents :: [Message],- interfaceEnums :: [WLEnum]- } deriving (Show)--type EnumName = String--- | wayland style enum specification (not Prelude)-data WLEnum = WLEnum {- enumName :: EnumName,- enumEntries :: [(String,Int)]- } deriving (Show)---- | wayland wire protocol argument type. we can't deal with untyped object/new-id arguments.-data ArgumentType = IntArg | UIntArg | FixedArg | StringArg | ObjectArg Name | NewIdArg Name MessageName | ArrayArg | FdArg deriving (Show)-argConversionTable :: [(String, ArgumentType)] -- for all easy argument types-argConversionTable = [- ("int", IntArg),- ("uint", UIntArg),- ("fixed", FixedArg),- ("string", StringArg),- ("fd", FdArg)]--type Argument = (String, ArgumentType, Bool) -- name, argument type, allow-null--type MessageName = String-data Message = Message {- messageName :: MessageName,- messageArguments :: [Argument],- messageIsDestructor :: Bool- } deriving (Show)--type ProtocolName = String-data ProtocolSpec = ProtocolSpec {- protocolName :: ProtocolName,- protocolInterfaces :: [Interface]- } deriving (Show)
hayland.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hayland-version: 0.1.0.0+version: 0.1.0.1 synopsis: Haskell bindings for the C Wayland library. description: This package contains bindings to the Wayland library, which is used to interface display devices, drawable clients, and window managers. .