Version of seed server using lenses

examples/seed/mu-example-seed.cabal

@@ -29,6 +29,7 @@ executable seed-server
   main-is:          Main.hs
   other-modules:    Schema
   default-language: Haskell2010
+  ghc-options:      -Wall -fprint-potential-instances
   build-depends:
       async           >=2.2   && <3
     , base            >=4.12  && <5
@@ -49,6 +50,7 @@ executable seed-server-optics
   main-is:          Optics.hs
   other-modules:    Schema
   default-language: Haskell2010
+  ghc-options:      -Wall -fprint-potential-instances
   build-depends:
       base            >=4.12  && <5
     , conduit         >=1.3.2 && <2
@@ -62,4 +64,22 @@ executable seed-server-optics
     , stm             >=2.5   && <3
     , text            >=1.2   && <2
 
+executable seed-server-lens
+  hs-source-dirs:   src
+  main-is:          Lens.hs
+  other-modules:    Schema
+  default-language: Haskell2010
   ghc-options:      -Wall -fprint-potential-instances
+  build-depends:
+      base            >=4.12  && <5
+    , conduit         >=1.3.2 && <2
+    , lens
+    , monad-logger    >=0.3   && <0.4
+    , mu-grpc-server  >=0.4.0
+    , mu-lens         >=0.3.0
+    , mu-protobuf     >=0.4.0
+    , mu-rpc          >=0.4.0
+    , mu-schema       >=0.3.0
+    , random          >=1.1   && <2
+    , stm             >=2.5   && <3
+    , text            >=1.2   && <2

examples/seed/src/Lens.hs

@@ -0,0 +1,77 @@
+{-# language DataKinds             #-}
+{-# language DuplicateRecordFields #-}
+{-# language FlexibleContexts      #-}
+{-# language OverloadedLabels      #-}
+{-# language OverloadedStrings     #-}
+{-# language PartialTypeSignatures #-}
+{-# language TypeApplications      #-}
+{-# language TypeOperators         #-}
+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
+
+module Main where
+
+import           Control.Concurrent       (threadDelay)
+import           Control.Lens
+import           Control.Monad.IO.Class   (liftIO)
+import           Control.Monad.Logger
+import           Data.Conduit
+import           Data.Conduit.Combinators as C
+import           Data.Text                as T
+import           Mu.GRpc.Server
+import           Mu.Schema
+import           Mu.Schema.Lens
+import           Mu.Server
+
+import           Schema
+
+type Person          = Term SeedSchema (SeedSchema :/: "Person")
+type PeopleRequest   = Term SeedSchema (SeedSchema :/: "PeopleRequest")
+type PeopleResponse  = Term SeedSchema (SeedSchema :/: "PeopleResponse")
+type Weather         = Term SeedSchema (SeedSchema :/: "Weather")
+type WeatherRequest  = Term SeedSchema (SeedSchema :/: "WeatherRequest")
+type WeatherResponse = Term SeedSchema (SeedSchema :/: "WeatherResponse")
+
+main :: IO ()
+main = do
+  putStrLn "running seed application"
+  runGRpcAppTrans msgProtoBuf 8080 runStderrLoggingT server
+
+-- Server implementation
+-- https://github.com/higherkindness/mu/blob/master/modules/examples/seed/server/modules/process/src/main/scala/example/seed/server/process/ProtoPeopleServiceHandler.scala
+
+server :: (MonadServer m, MonadLogger m) => SingleServerT info PeopleService m _
+server = singleService
+  ( method @"getPerson" getPerson
+  , method @"getPersonStream" getPersonStream
+  , method @"getWeather" getWeather )
+
+evolvePerson :: PeopleRequest -> PeopleResponse
+evolvePerson req = record (Just $ record (req ^. #name, 18))
+
+getPerson :: Monad m => PeopleRequest -> m PeopleResponse
+getPerson = pure . evolvePerson
+
+getPersonStream
+  :: (MonadServer m, MonadLogger m)
+  => ConduitT () PeopleRequest m ()
+  -> ConduitT PeopleResponse Void m ()
+  -> m ()
+getPersonStream source sink = runConduit $ source .| C.mapM reStream .| sink
+  where
+    reStream req = do
+      liftIO $ threadDelay (2 * 1000 * 1000) -- 2 sec
+      logDebugN $ T.pack $ "stream request: " ++ show req
+      pure $ evolvePerson req
+
+getWeather :: (MonadServer m)
+           => WeatherRequest
+           -> m WeatherResponse
+getWeather msg
+ | Just w <- msg ^. #currentWeather
+ = pure $ record (go w)
+ | otherwise
+ = pure $ record "who knows?"
+ where go e | not $ e `isn't` #sunny  = "is sunny! 😄"
+            | not $ e `isn't` #cloudy = "is cloudy 😟"
+            | not $ e `isn't` #rainy  = "is rainy... 😭"
+            | otherwise               = error "this should never happen"