diff --git a/cbits/grpc_haskell.c b/cbits/grpc_haskell.c new file mode 100644 index 0000000..287afa9 --- /dev/null +++ b/cbits/grpc_haskell.c @@ -0,0 +1,11 @@ +#include + +grpc_event *grpc_completion_queue_next_(grpc_completion_queue *cq, gpr_timespec *deadline) { + grpc_completion_queue_next(cq, *deadline); +} + +grpc_event* grpc_completion_queue_pluck_(grpc_completion_queue *cq, void *tag, gpr_timespec *deadline) { + grpc_completion_queue_pluck(cq, tag, *deadline); +} + + diff --git a/grpc-haskell.cabal b/grpc-haskell.cabal index 35e3264..ea5cde8 100644 --- a/grpc-haskell.cabal +++ b/grpc-haskell.cabal @@ -1,6 +1,3 @@ --- Initial grpc-haskell.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: grpc-haskell version: 0.0.0.0 synopsis: Haskell implementation of gRPC layered on shared C library. @@ -10,27 +7,41 @@ license: Apache-2.0 license-file: LICENSE author: Alois Cochard maintainer: alois.cochard@gmail.com --- copyright: +copyright: Copyright 2015 Alois Cochard category: Network build-type: Simple --- extra-source-files: cabal-version: >=1.10 +extra-source-files: cbits, include library + build-depends: + base >=4.7 && <4.8 + , clock >=0.4 && <0.5 + c-sources: + cbits/grpc_haskell.c exposed-modules: - Network.GRPC - Network.GRPC.Constants - Network.GRPC.Time - -- other-modules: - -- other-extensions: + Network.GRPC.Core + Network.GRPC.Core.Constants + Network.GRPC.Core.Time extra-libraries: grpc includes: - grpc/grpc.h + include/grpc_haskell.h + , grpc/grpc.h + , grpc/status.h , grpc/support/time.h build-tools: c2hs - build-depends: - base >=4.7 && <4.8 - , clock >=0.4 && <0.5 - hs-source-dirs: src default-language: Haskell2010 + ghc-options: -Wall -fwarn-incomplete-patterns + include-dirs: include + hs-source-dirs: src + +test-suite test + build-depends: + base + , QuickCheck >= 2.7 && < 2.8 + default-language: Haskell2010 + ghc-options: -Wall -fwarn-incomplete-patterns -O2 -threaded -rtsopts + hs-source-dirs: tests + main-is: Properties.hs + type: exitcode-stdio-1.0 diff --git a/include/grpc_haskell.h b/include/grpc_haskell.h new file mode 100644 index 0000000..2c206e3 --- /dev/null +++ b/include/grpc_haskell.h @@ -0,0 +1,12 @@ +#include + +grpc_event *grpc_completion_queue_next_(grpc_completion_queue *cq, + gpr_timespec *deadline); + +grpc_event *grpc_completion_queue_pluck_(grpc_completion_queue *cq, void *tag, + gpr_timespec *deadline); + +grpc_call *grpc_channel_create_call_(grpc_channel *channel, + grpc_completion_queue *completion_queue, + const char *method, const char *host, + gpr_timespec *deadline); diff --git a/src/Network/GRPC.chs b/src/Network/GRPC.chs deleted file mode 100644 index 235a74a..0000000 --- a/src/Network/GRPC.chs +++ /dev/null @@ -1,21 +0,0 @@ -module Network.GRPC where - -import Foreign.Ptr - -#include "grpc/grpc.h" - -{#context prefix = "grpc" #} - -{#pointer *grpc_channel as Channel newtype #} -{#pointer *grpc_server as Server newtype #} -{#pointer *grpc_call as Call newtype #} - -{#enum grpc_arg_type as ArgType {underscoreToCase} deriving (Eq)#} -{#enum grpc_call_error as CallError {underscoreToCase} deriving (Eq)#} -{#enum grpc_op_error as OpError {underscoreToCase} deriving (Eq)#} - -{#enum grpc_completion_type as CompletionType {underscoreToCase} deriving (Eq)#} - -{#fun grpc_init as ^ {} -> `()'#} -{#fun grpc_shutdown as ^ {} -> `()'#} - diff --git a/src/Network/GRPC/Core.chs b/src/Network/GRPC/Core.chs new file mode 100644 index 0000000..266ccce --- /dev/null +++ b/src/Network/GRPC/Core.chs @@ -0,0 +1,68 @@ +module Network.GRPC.Core where + +-- TODO Remove wrapped function once once https://github.com/haskell/c2hs/issues/117 gets in + +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr + +import Network.GRPC.Core.Time + +#include +#include +#include + +{#context prefix = "grpc" #} + +{#pointer *gpr_timespec as CTimeSpecPtr -> CTimeSpec #} +{#enum grpc_status_code as StatusCode {underscoreToCase} deriving (Eq)#} + +{#pointer *grpc_completion_queue as CompletionQueue newtype #} +{#pointer *grpc_channel as Channel newtype #} +{#pointer *grpc_server as Server newtype #} +{#pointer *grpc_call as Call newtype #} + +-- {#enum grpc_arg_type as ArgType {underscoreToCase} deriving (Eq)#} + +newtype ChannelArgs = ChannelArgs [Arg] + +-- TODO Storable ChannelArgs + +{#pointer *grpc_channel_args as ChannelArgsPtr -> ChannelArgs #} + +data Arg = Arg { argKey :: String, argValue :: ArgValue } +data ArgValue = ArgString String | ArgInt Int + +{#enum grpc_call_error as CallError {underscoreToCase} deriving (Eq)#} +{#enum grpc_op_error as OpError {underscoreToCase} deriving (Eq)#} + +{#pointer *grpc_byte_buffer as ByteBuffer newtype #} +{#pointer *grpc_byte_buffer_reader as ByteBufferReader newtype #} + +{#enum grpc_completion_type as CompletionType {underscoreToCase} deriving (Eq)#} +{#pointer *grpc_event as Event newtype #} +{#enum grpc_op_type as OpType {underscoreToCase} deriving (Eq)#} +{#pointer *grpc_op as Op newtype #} + +{#fun grpc_init as ^ {} -> `()'#} +{#fun grpc_shutdown as ^ {} -> `()'#} + +{#fun grpc_completion_queue_create as ^ {} -> `CompletionQueue'#} + +{#fun grpc_completion_queue_next_ as ^ {`CompletionQueue', `CTimeSpecPtr'} -> `Event'#} +{#fun grpc_completion_queue_pluck_ as ^ {`CompletionQueue', `Ptr ()'} -> `Event'#} + +{#fun grpc_event_finish as ^ {`Event'} -> `()'#} + +{#fun grpc_completion_queue_shutdown as ^ {`CompletionQueue'} -> `()'#} +{#fun grpc_completion_queue_destroy as ^ {`CompletionQueue'} -> `()'#} + +{#fun grpc_channel_create_call_ as ^ {`Channel', `CompletionQueue', `String', `String', `CTimeSpecPtr'} -> `Call'#} +{#fun grpc_channel_create as ^ {`String', `ChannelArgsPtr'} -> `Channel'#} +{#fun grpc_channel_destroy as ^ {`Channel'} -> `()'#} + +{#fun grpc_call_start_batch as ^ {`Call', `Op', `Int', `Ptr ()'} -> `CallError'#} +{#fun grpc_call_cancel as ^ {`Call'} -> `()'#} +{#fun grpc_call_cancel_with_status as ^ {`Call', `StatusCode', `String'} -> `()'#} +{#fun grpc_call_destroy as ^ {`Call'} -> `()'#} + diff --git a/src/Network/GRPC/Constants.hsc b/src/Network/GRPC/Core/Constants.hsc similarity index 91% rename from src/Network/GRPC/Constants.hsc rename to src/Network/GRPC/Core/Constants.hsc index 406fa47..eea2307 100644 --- a/src/Network/GRPC/Constants.hsc +++ b/src/Network/GRPC/Core/Constants.hsc @@ -1,4 +1,4 @@ -module Network.GRPC.Constants where +module Network.GRPC.Core.Constants where #include "grpc/grpc.h" diff --git a/src/Network/GRPC/Time.chs b/src/Network/GRPC/Core/Time.chs similarity index 82% rename from src/Network/GRPC/Time.chs rename to src/Network/GRPC/Core/Time.chs index 4466ca0..907b3f8 100644 --- a/src/Network/GRPC/Time.chs +++ b/src/Network/GRPC/Core/Time.chs @@ -1,18 +1,16 @@ -module Network.GRPC.Time where +module Network.GRPC.Core.Time where import Control.Applicative import Control.Monad import Foreign.C.Types -import Foreign.Ptr import Foreign.Storable import System.Clock -#include "grpc/support/time.h" +#include {#context prefix = "grp" #} newtype CTimeSpec = CTimeSpec { timeSpec :: TimeSpec } -{#pointer *gpr_timespec as CTimeSpecPtr -> CTimeSpec #} instance Storable CTimeSpec where sizeOf _ = {#sizeof gpr_timespec #} diff --git a/tests/Properties.hs b/tests/Properties.hs new file mode 100644 index 0000000..377b6b5 --- /dev/null +++ b/tests/Properties.hs @@ -0,0 +1,2 @@ +main :: IO () +main = return ()