fix warnings, stylish-haskell, wibbles

grpc-haskell.cabal

@@ -56,7 +56,7 @@ library
     , grpc/impl/codegen/slice.h
   build-tools:          c2hs
   default-language:     Haskell2010
-  ghc-options:          -Wall -fwarn-incomplete-patterns
+  ghc-options:          -Wall -fwarn-incomplete-patterns -fno-warn-unused-do-bind
   include-dirs:         include
   hs-source-dirs:       src
   default-extensions:   CPP
@@ -80,7 +80,7 @@ test-suite test
     LowLevelTests,
     UnsafeTests
   default-language:     Haskell2010
-  ghc-options:          -Wall -fwarn-incomplete-patterns -g -threaded
+  ghc-options:          -Wall -fwarn-incomplete-patterns -fno-warn-unused-do-bind -g -threaded
   hs-source-dirs:       tests
   main-is:              Properties.hs
   type:                 exitcode-stdio-1.0

src/Network/GRPC/LowLevel/Call.hs

@@ -107,3 +107,9 @@ destroyCall call@ServerCall{..} = do
   forM_ callDetails C.destroyCallDetails
   grpcDebug $ "destroying deadline." ++ show callDeadline
   forM_ callDeadline C.timespecDestroy
+
+_nowarn_unused :: a
+_nowarn_unused =
+  castPtr `undefined`
+  (peek :: Ptr Int -> IO Int) `undefined`
+  ()

src/Network/GRPC/LowLevel/CompletionQueue.hs

@@ -6,8 +6,8 @@
 
 {-# LANGUAGE RecordWildCards #-}
 
-module Network.GRPC.LowLevel.CompletionQueue (
+module Network.GRPC.LowLevel.CompletionQueue
-  CompletionQueue
+  ( CompletionQueue
   , withCompletionQueue
   , createCompletionQueue
   , shutdownCompletionQueue
@@ -16,33 +16,35 @@ module Network.GRPC.LowLevel.CompletionQueue (
   , channelCreateRegisteredCall
   , channelCreateCall
   , TimeoutSeconds
-  , eventSuccess
+  , isEventSuccessful
   , serverRegisterCompletionQueue
   , serverShutdownAndNotify
   , serverRequestRegisteredCall
   , serverRequestCall
   , newTag
-) where
+  )
+where
 
 import           Control.Concurrent            (forkIO, threadDelay)
-import           Control.Concurrent.STM (atomically, retry, check)
+import           Control.Concurrent.STM        (atomically, check, retry)
-import           Control.Concurrent.STM.TVar (TVar, newTVarIO, modifyTVar',
+import           Control.Concurrent.STM.TVar   (TVar, modifyTVar', newTVarIO,
                                                 readTVar, writeTVar)
 import           Control.Exception             (bracket)
-import           Data.IORef (IORef, newIORef, atomicModifyIORef')
+import           Data.IORef                    (IORef, atomicModifyIORef',
+                                                newIORef)
 import           Data.List                     (intersperse)
-import           Foreign.Marshal.Alloc (malloc, free)
+import           Foreign.Marshal.Alloc         (free, malloc)
 import           Foreign.Ptr                   (nullPtr, plusPtr)
 import           Foreign.Storable              (peek)
 import qualified Network.GRPC.Unsafe           as C
 import qualified Network.GRPC.Unsafe.Constants as C
-import qualified Network.GRPC.Unsafe.Time as C
-import qualified Network.GRPC.Unsafe.Op as C
 import qualified Network.GRPC.Unsafe.Metadata  as C
+import qualified Network.GRPC.Unsafe.Op        as C
+import qualified Network.GRPC.Unsafe.Time      as C
 import           System.Timeout                (timeout)
 
-import Network.GRPC.LowLevel.GRPC
 import           Network.GRPC.LowLevel.Call
+import           Network.GRPC.LowLevel.GRPC
 
 -- NOTE: the concurrency requirements for a CompletionQueue are a little
 -- complicated. There are two read operations: next and pluck. We can either
@@ -159,13 +161,14 @@ eventToError (C.Event C.QueueShutdown _ _) = Left GRPCIOShutdown
 eventToError (C.Event C.QueueTimeout _ _) = Left GRPCIOTimeout
 eventToError _ = Left GRPCIOUnknownError
 
-isFailedEvent :: C.Event -> Bool
+-- | Returns true iff the given grpc_event was a success.
-isFailedEvent C.Event{..} = (eventCompletionType /= C.OpComplete)
+isEventSuccessful :: C.Event -> Bool
-                            || not eventSuccess
+isEventSuccessful (C.Event C.OpComplete True _) = True
+isEventSuccessful _ = False
 
 -- | Waits for the given number of seconds for the given tag to appear on the
 -- completion queue. Throws 'GRPCIOShutdown' if the completion queue is shutting
---down and cannot handle new requests.
+-- down and cannot handle new requests.
 pluck :: CompletionQueue -> C.Tag -> TimeoutSeconds
          -> IO (Either GRPCIOError ())
 pluck cq@CompletionQueue{..} tag waitSeconds = do
@@ -175,9 +178,7 @@ pluck cq@CompletionQueue{..} tag waitSeconds = do
     C.withDeadlineSeconds waitSeconds $ \deadline -> do
       ev <- C.grpcCompletionQueuePluck unsafeCQ tag deadline C.reserved
       grpcDebug $ "pluck: finished. Event: " ++ show ev
-      if isFailedEvent ev
+      return $ if isEventSuccessful ev then Right () else eventToError ev
-         then return $ eventToError ev
-         else return $ Right ()
 
 -- TODO: I'm thinking it might be easier to use 'Either' uniformly everywhere
 -- even when it's isomorphic to 'Maybe'. If that doesn't turn out to be the
@@ -207,7 +208,7 @@ shutdownCompletionQueue (CompletionQueue{..}) = do
   atomically $ readTVar currentPluckers >>= \x -> check (x == 0)
   --drain the queue
   C.grpcCompletionQueueShutdown unsafeCQ
-  loopRes <- timeout (5*10^6) drainLoop
+  loopRes <- timeout (5*10^(6::Int)) drainLoop
   case loopRes of
     Nothing -> return $ Left GRPCIOShutdownFailure
     Just () -> C.grpcCompletionQueueDestroy unsafeCQ >> return (Right ())
@@ -221,11 +222,6 @@ shutdownCompletionQueue (CompletionQueue{..}) = do
             C.QueueTimeout -> drainLoop
             C.OpComplete -> drainLoop
 
--- | Returns true iff the given grpc_event was a success.
-eventSuccess :: C.Event -> Bool
-eventSuccess (C.Event C.OpComplete True _) = True
-eventSuccess _ = False
-
 channelCreateRegisteredCall :: C.Channel -> C.Call -> C.PropagationMask
                                -> CompletionQueue -> C.CallHandle
                                -> C.CTimeSpecPtr -> IO (Either GRPCIOError Call)
@@ -290,7 +286,7 @@ serverRequestRegisteredCall
                      return $ Right assembledCall
       -- TODO: see TODO for failureCleanup in serverRequestCall.
       where failureCleanup deadline callPtr metadataArrayPtr bbPtr = forkIO $ do
-              threadDelay (30*10^6)
+              threadDelaySecs 30
               grpcDebug "serverRequestRegisteredCall: doing delayed cleanup."
               C.timespecDestroy deadline
               free callPtr
@@ -340,7 +336,7 @@ serverRequestCall server cq@CompletionQueue{..} timeLimit =
       -- we sleep for a while before freeing the objects. We should find a
       -- permanent solution that's more robust.
       where failureCleanup callPtr callDetails metadataArrayPtr = forkIO $ do
-              threadDelay (30*10^6)
+              threadDelaySecs 30
               grpcDebug "serverRequestCall: doing delayed cleanup."
               free callPtr
               C.destroyCallDetails callDetails
@@ -356,3 +352,6 @@ serverRegisterCompletionQueue server CompletionQueue{..} =
 serverShutdownAndNotify :: C.Server -> CompletionQueue -> C.Tag -> IO ()
 serverShutdownAndNotify server CompletionQueue{..} tag =
   C.grpcServerShutdownAndNotify server unsafeCQ tag
+
+threadDelaySecs :: Int -> IO ()
+threadDelaySecs = threadDelay . (* 10^(6::Int))

src/Network/GRPC/LowLevel/GRPC.hs

@@ -51,7 +51,7 @@ grpcDebug :: String -> IO ()
 grpcDebug str = do tid <- myThreadId
                    putStrLn $ (show tid) ++ ": " ++ str
 #else
-grpcDebug str = return ()
+grpcDebug _ = return ()
 #endif
 
 {-

src/Network/GRPC/LowLevel/Op.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards            #-}
 
 module Network.GRPC.LowLevel.Op where
 
@@ -10,17 +10,18 @@ import           Data.Maybe (catMaybes)
 import           Data.String                           (IsString)
 import           Foreign.C.String                      (CString)
 import           Foreign.C.Types                       (CInt)
-import           Foreign.Marshal.Alloc (malloc, mallocBytes, free)
+import           Foreign.Marshal.Alloc                 (free, malloc,
+                                                        mallocBytes)
 import           Foreign.Ptr                           (Ptr, nullPtr)
 import           Foreign.Storable                      (peek, poke)
-import qualified Network.GRPC.Unsafe as C
+import qualified Network.GRPC.Unsafe                   as C ()
-import qualified Network.GRPC.Unsafe.Metadata as C
 import qualified Network.GRPC.Unsafe.ByteBuffer        as C
+import qualified Network.GRPC.Unsafe.Metadata          as C
 import qualified Network.GRPC.Unsafe.Op                as C
 
-import Network.GRPC.LowLevel.GRPC
-import Network.GRPC.LowLevel.CompletionQueue
 import           Network.GRPC.LowLevel.Call
+import           Network.GRPC.LowLevel.CompletionQueue
+import           Network.GRPC.LowLevel.GRPC
 
 type MetadataMap = M.Map B.ByteString B.ByteString
 
@@ -224,3 +225,6 @@ runOps call cq ops timeLimit =
                 grpcDebug "runOps: got good op; starting."
                 fmap (Right . catMaybes) $ mapM resultFromOpContext contexts
               Left err -> return $ Left err
+
+_nowarn_unused :: a
+_nowarn_unused = undefined nullPtr

src/Network/GRPC/LowLevel/Server.hs

@@ -12,12 +12,17 @@ import           Foreign.Storable (peek)
 import qualified Network.GRPC.Unsafe                   as C
 import qualified Network.GRPC.Unsafe.Op                as C
 
-import           Network.GRPC.LowLevel.GRPC
-import           Network.GRPC.LowLevel.CompletionQueue (CompletionQueue,
-                 pluck, serverRegisterCompletionQueue, serverShutdownAndNotify,
-                 createCompletionQueue, shutdownCompletionQueue, TimeoutSeconds,
-                 serverRequestRegisteredCall, serverRequestCall)
 import           Network.GRPC.LowLevel.Call
+import           Network.GRPC.LowLevel.CompletionQueue (CompletionQueue,
+                                                        TimeoutSeconds,
+                                                        createCompletionQueue,
+                                                        pluck,
+                                                        serverRegisterCompletionQueue,
+                                                        serverRequestCall,
+                                                        serverRequestRegisteredCall,
+                                                        serverShutdownAndNotify,
+                                                        shutdownCompletionQueue)
+import           Network.GRPC.LowLevel.GRPC
 import           Network.GRPC.LowLevel.Op
 
 import qualified Network.GRPC.Unsafe.ByteBuffer        as C
@@ -199,7 +204,7 @@ serverHandleNormalRegisteredCall :: Server
                              -- metadata and returns a response body and
                              -- metadata.
                           -> IO (Either GRPCIOError ())
-serverHandleNormalRegisteredCall s@Server{..} rm timeLimit initMetadata f = do
+serverHandleNormalRegisteredCall s@Server{..} rm timeLimit srvMetadata f = do
   -- TODO: we use this timeLimit twice, so the max time spent is 2*timeLimit.
   -- Should we just hard-code time limits instead? Not sure if client
   -- programmer cares, since this function will likely just be put in a loop
@@ -229,16 +234,16 @@ serverHandleNormalRegisteredCall s@Server{..} rm timeLimit initMetadata f = do
 -- | Handle one unregistered call.
 serverHandleNormalCall :: Server -> TimeoutSeconds
                           -> MetadataMap
-                          -- ^ Initial metadata.
+                          -- ^ Initial server metadata.
                           -> (ByteString -> MetadataMap
                               -> IO (ByteString, MetadataMap, StatusDetails))
                           -- ^ Handler function takes a request body and
                           -- metadata and returns a response body and metadata.
                           -> IO (Either GRPCIOError ())
-serverHandleNormalCall s@Server{..} timeLimit initMetadata f = do
+serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do
   withServerCall s timeLimit $ \call -> do
     grpcDebug "serverHandleNormalCall: starting batch."
-    let recvOps = serverOpsGetNormalCall initMetadata
+    let recvOps = serverOpsGetNormalCall srvMetadata
     opResults <- runOps call serverCQ recvOps timeLimit
     case opResults of
       Left x -> return $ Left x
@@ -255,3 +260,6 @@ serverHandleNormalCall s@Server{..} timeLimit initMetadata f = do
           Right _ -> grpcDebug "serverHandleNormalCall: ops done."
                      >> return (Right ())
       x -> error $ "impossible pattern match: " ++ show x
+
+_nowarn_unused :: a
+_nowarn_unused = undefined threadDelay