Merge pull request #237 from well-typed/edsko/lowlevel

Low-level tutorial, cleanup docs

.github/workflows/haskell-ci.yml

@@ -158,6 +158,7 @@ jobs:
           echo "packages: $GITHUB_WORKSPACE/source/./grapesy" >> cabal.project
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/./tutorials/quickstart" >> cabal.project ; fi
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/./tutorials/basics" >> cabal.project ; fi
+          if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/./tutorials/lowlevel" >> cabal.project ; fi
           cat cabal.project
       - name: sdist
         run: |
@@ -175,18 +176,23 @@ jobs:
           echo "PKGDIR_quickstart=${PKGDIR_quickstart}" >> "$GITHUB_ENV"
           PKGDIR_basics="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/basics-[0-9.]*')"
           echo "PKGDIR_basics=${PKGDIR_basics}" >> "$GITHUB_ENV"
+          PKGDIR_basics="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/basics-[0-9.]*')"
+          echo "PKGDIR_basics=${PKGDIR_basics}" >> "$GITHUB_ENV"
           rm -f cabal.project cabal.project.local
           touch cabal.project
           touch cabal.project.local
           echo "packages: ${PKGDIR_grapesy}" >> cabal.project
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_quickstart}" >> cabal.project ; fi
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_basics}" >> cabal.project ; fi
+          if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_basics}" >> cabal.project ; fi
           echo "package grapesy" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods" >> cabal.project
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "package quickstart" >> cabal.project ; fi
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "package basics" >> cabal.project ; fi
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
+          if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "package basics" >> cabal.project ; fi
+          if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
           cat >> cabal.project <<EOF
           allow-newer: proto-lens:base
           allow-newer: proto-lens-runtime:base
@@ -230,6 +236,8 @@ jobs:
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cd ${PKGDIR_basics} || false ; fi
           if [ $((HCNUMVER < 91000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi
+          if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cd ${PKGDIR_basics} || false ; fi
+          if [ $((HCNUMVER < 91000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi
       - name: haddock
         run: |
           $CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

cabal.project

@@ -1,4 +1,8 @@
-packages: ./grapesy, ./tutorials/quickstart, ./tutorials/basics
+packages: 
+    ./grapesy
+  , ./tutorials/quickstart
+  , ./tutorials/basics
+  , ./tutorials/lowlevel
 
 package grapesy
   tests: True

grapesy/demo-client/Demo/Client/API/Core/Greeter.hs

@@ -8,6 +8,7 @@ import Control.Exception
 import Network.GRPC.Client
 import Network.GRPC.Common
 import Network.GRPC.Common.Protobuf
+import Network.GRPC.Common.StreamElem qualified as StreamElem
 
 import Demo.Client.Util.DelayOr (DelayOr)
 import Demo.Client.Util.DelayOr qualified as DelayOr
@@ -32,7 +33,7 @@ sayHelloStreamReply conn name =
 
       -- For completeness, we also show the final metadata, although the
       -- example does not include any.
-      finalMetadata <- recvAllOutputs call logMsg
+      finalMetadata <- StreamElem.whileNext_ (recvOutput call) logMsg
       logMsg finalMetadata
 
 sayHelloBidiStream :: Connection -> [DelayOr (Proto HelloRequest)] -> IO ()

grapesy/demo-client/Demo/Client/API/Core/RouteGuide.hs

@@ -5,6 +5,7 @@ module Demo.Client.API.Core.RouteGuide (
 import Network.GRPC.Client
 import Network.GRPC.Common
 import Network.GRPC.Common.Protobuf
+import Network.GRPC.Common.StreamElem qualified as StreamElem
 
 import Demo.Client.Util.Logging
 
@@ -27,7 +28,7 @@ listFeatures conn r = do
       initMetadata <- recvResponseInitialMetadata call
       logMsg initMetadata
 
-      finalMetadata <- recvAllOutputs call $ logMsg
+      finalMetadata <- StreamElem.whileNext_ (recvOutput call) logMsg
       logMsg finalMetadata
 
 

grapesy/src/Network/GRPC/Client.hs

@@ -53,10 +53,6 @@ module Network.GRPC.Client (
   , recvFinalOutput
   , recvTrailers
 
-    -- ** Repeated send/recv
-  , sendAllInputs
-  , recvAllOutputs
-
     -- ** Low-level\/specialized API
   , ResponseHeaders_(..)
   , ResponseHeaders

grapesy/src/Network/GRPC/Client/Call.hs

@@ -21,10 +21,6 @@ module Network.GRPC.Client.Call (
   , recvFinalOutput
   , recvTrailers
 
-    -- ** Repeated send/recv
-  , sendAllInputs
-  , recvAllOutputs
-
     -- ** Low-level\/specialized API
   , sendInputWithMeta
   , recvNextOutputElem
@@ -569,49 +565,6 @@ recvTrailers call@Call{} = liftIO $ do
     err :: ProtocolException rpc -> IO a
     err = throwM . ProtocolException
 
-{-------------------------------------------------------------------------------
-  Repeated send/recv
--------------------------------------------------------------------------------}
-
--- | Send all inputs returned by the specified action
---
--- Terminates after the action returns 'FinalElem' or 'NoMoreElems'
-sendAllInputs :: forall m rpc.
-     MonadIO m
-  => Call rpc
-  -> m (StreamElem NoMetadata (Input rpc))
-  -> m ()
-sendAllInputs call produceInput = loop
-  where
-    loop :: m ()
-    loop = do
-        inp <- produceInput
-        sendInput call inp
-        case inp of
-          StreamElem{}  -> loop
-          FinalElem{}   -> return ()
-          NoMoreElems{} -> return ()
-
-recvAllOutputs :: forall m rpc.
-     MonadIO m
-  => Call rpc
-  -> (Output rpc -> m ())
-  -> m (ResponseTrailingMetadata rpc)
-recvAllOutputs call processOutput = loop
-  where
-    loop :: m (ResponseTrailingMetadata rpc)
-    loop = do
-        mOut <- recvOutput call
-        case mOut of
-          StreamElem out -> do
-            processOutput out
-            loop
-          NoMoreElems trailers ->
-            return trailers
-          FinalElem out trailers -> do
-            processOutput out
-            return trailers
-
 {-------------------------------------------------------------------------------
   Internal auxiliary: deal with final message
 -------------------------------------------------------------------------------}

grapesy/src/Network/GRPC/Common/NextElem.hs

@@ -8,16 +8,19 @@
 -- @NextElem(..)@, but none of the operations on 'NextElem'.
 module Network.GRPC.Common.NextElem (
     NextElem(..)
-    -- * API
+    -- * Conversion
+  , toStreamElem
+    -- * Iteration
   , mapM_
   , forM_
-  , collect
   , whileNext_
-  , toStreamElem
+  , collect
   ) where
 
 import Prelude hiding (mapM_)
 
+import Control.Monad.State (StateT, execStateT, lift, modify)
+
 import Network.GRPC.Common.StreamElem (StreamElem(..))
 
 {-------------------------------------------------------------------------------
@@ -31,30 +34,39 @@ data NextElem a = NoNextElem | NextElem !a
   deriving stock (Show, Eq, Functor, Foldable, Traversable)
 
 {-------------------------------------------------------------------------------
-  API
+  Conversion
+-------------------------------------------------------------------------------}
+
+toStreamElem :: b -> NextElem a -> StreamElem b a
+toStreamElem b NoNextElem   = NoMoreElems b
+toStreamElem _ (NextElem a) = StreamElem a
+
+{-------------------------------------------------------------------------------
+  Iteration
 -------------------------------------------------------------------------------}
 
+-- | Invoke the callback for each element, and then once more with 'NoNextElem'
+--
+-- >    mapM_ f [1,2,3]
+-- > == do f (NextElem 1)
+-- >       f (NextElem 2)
+-- >       f (NextElem 3)
+-- >       f NoNextElem
 mapM_ :: forall m a. Monad m => (NextElem a -> m ()) -> [a] -> m ()
 mapM_ f = go
   where
     go :: [a] -> m ()
     go []     = f NoNextElem
     go (x:xs) = f (NextElem x) >> go xs
 
+-- | Like 'mapM_', but with the arguments in opposite order
 forM_ :: Monad m => [a] -> (NextElem a -> m ()) -> m ()
 forM_ = flip mapM_
 
-collect :: forall m a. Monad m => m (NextElem a) -> m [a]
-collect f = go []
-  where
-    go :: [a] -> m [a]
-    go acc = do
-         ma <- f
-         case ma of
-           NoNextElem -> return (reverse acc)
-           NextElem a -> go (a:acc)
-
-whileNext_ :: forall m a b. Monad m => m (NextElem a) -> (a -> m b) -> m ()
+-- | Invoke a function on each 'NextElem', until 'NoNextElem'
+--
+-- See also 'collect'.
+whileNext_ :: forall m a. Monad m => m (NextElem a) -> (a -> m ()) -> m ()
 whileNext_ f g = go
   where
     go :: m ()
@@ -64,6 +76,11 @@ whileNext_ f g = go
           NoNextElem -> return ()
           NextElem a -> g a >> go
 
-toStreamElem :: b -> NextElem a -> StreamElem b a
-toStreamElem b NoNextElem   = NoMoreElems b
-toStreamElem _ (NextElem a) = StreamElem a
+-- | Invoke the callback until it returns 'NoNextElem', collecting results
+collect :: forall m a. Monad m => m (NextElem a) -> m [a]
+collect f =
+    reverse <$> flip execStateT [] aux
+  where
+    aux :: StateT [a] m ()
+    aux = whileNext_ (lift f) $ modify . (:)
+

grapesy/src/Network/GRPC/Common/StreamElem.hs

@@ -8,16 +8,24 @@
 -- @StreamElem(..)@, but none of the operations on 'StreamElem'.
 module Network.GRPC.Common.StreamElem (
     StreamElem(..)
-    -- * API
+    -- * Conversion
   , value
+    -- * Iteration
+    -- * Iteration
+  , mapM_
+  , forM_
+  , whileNext_
+  , collect
   , whenDefinitelyFinal
   ) where
 
 import Prelude hiding (mapM_)
 
+import Control.Monad.State (StateT, runStateT, lift, modify)
 import Data.Bifoldable
 import Data.Bifunctor
 import Data.Bitraversable
+import Data.Tuple (swap)
 
 {-------------------------------------------------------------------------------
   Definition
@@ -78,7 +86,7 @@ instance Bitraversable StreamElem where
   bitraverse _ f (StreamElem  a  ) = StreamElem  <$> f a
 
 {-------------------------------------------------------------------------------
-  API
+  Conversion
 -------------------------------------------------------------------------------}
 
 -- | Value of the element, if one is present
@@ -93,10 +101,58 @@ value = \case
     FinalElem  a _ -> Just a
     NoMoreElems  _ -> Nothing
 
+{-------------------------------------------------------------------------------
+  Iteration
+-------------------------------------------------------------------------------}
+
+-- | Invoke the callback for each element
+--
+-- The final element is marked using 'FinalElem'; the callback is only invoked
+-- on 'NoMoreElems' if the list is empty.
+--
+-- >    mapM_ f ([1,2,3], b)
+-- > == do f (StreamElem 1)
+-- >       f (StreamElem 2)
+-- >       f (FinalElem 3 b)
+-- >
+-- >    mapM_ f ([], b)
+-- > == do f (NoMoreElems b)
+mapM_ :: forall m a b. Monad m => (StreamElem b a -> m ()) -> [a] -> b -> m ()
+mapM_ f = go
+  where
+    go :: [a] -> b -> m ()
+    go []     b = f (NoMoreElems b)
+    go [a]    b = f (FinalElem a b)
+    go (a:as) b = f (StreamElem a) >> go as b
+
+-- | Like 'mapM_', but with the arguments in opposite order
+forM_ :: Monad m => [a] -> b -> (StreamElem b a -> m ()) -> m ()
+forM_ as b f = mapM_ f as b
+
+-- | Invoke a function on each 'NextElem', until 'FinalElem' or 'NoMoreElems'
+whileNext_ :: forall m a b. Monad m => m (StreamElem b a) -> (a -> m ()) -> m b
+whileNext_ f g = go
+  where
+    go :: m b
+    go = do
+        ma <- f
+        case ma of
+          StreamElem  a   -> g a >> go
+          FinalElem   a b -> g a >> return b
+          NoMoreElems   b -> return b
+
+-- | Invoke the callback until it returns 'NoNextElem', collecting results
+collect :: forall m b a. Monad m => m (StreamElem b a) -> m ([a], b)
+collect f =
+    first reverse . swap <$> flip runStateT [] aux
+  where
+    aux :: StateT [a] m b
+    aux = whileNext_ (lift f) $ modify . (:)
+
 -- | Do we have evidence that this element is the final one?
 --
--- A 'False' result does not mean the element is not final; see 'StreamElem' for
--- detailed discussion.
+-- The callback is not called on 'StreamElem'; this does /not/ mean that the
+-- element was not final; see 'StreamElem' for detailed discussion.
 whenDefinitelyFinal :: Applicative m => StreamElem b a -> (b -> m ()) -> m ()
 whenDefinitelyFinal msg k =
     case msg of

tutorials/basics/README.md

@@ -0,0 +1,4 @@
+# Basics tutorial
+
+This is the `grapesy` translation of the
+[official Basics tutorial](https://grpc.io/docs/languages/python/basics/).

tutorials/lowlevel/LICENSE

@@ -0,0 +1,31 @@
+Copyright (c) 2023-2024, Well-Typed LLP and Anduril Industries Inc.
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Well-Typed LLP, the name of Anduril
+      Industries Inc., nor the names of other contributors may be
+      used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

tutorials/lowlevel/README.md

@@ -0,0 +1,8 @@
+# Basics tutorial using the low-level API
+
+See `/tutorials/basics` for the more direct `grapesy` translation of the
+[official Basics tutorial](https://grpc.io/docs/languages/python/basics/).
+
+In this tutorial we re-implement both the server and the client using the
+low-level `grapesy` API (that is, without using the support for the Protobuf
+communication patterns).

tutorials/lowlevel/Setup.hs

@@ -0,0 +1,3 @@
+import Data.ProtoLens.Setup
+
+main = defaultMainGeneratingProtos "proto"