如何在 servant-websocket 的管道端点中使用自己的 Monad？

Question

我正在尝试弄清楚如何在 servant-websocket 库提供的 WebSocketConduit 端点的 ConduitT 定义中使用自定义 monad。

说我有这个API:

type MyAPI = "ws" :> WebSocketConduit Value Value

如果我尝试为该端点定义一个只复制输入的处理程序，但我指定了一个与参数不同的 Monad m:

ws :: ConduitT Value Value (Reader String) ()
ws _ = CL.map id

我收到这个错误：

    • Couldn't match type: transformers-0.5.6.2:Control.Monad.Trans.Reader.ReaderT
                             String Data.Functor.Identity.Identity
                     with: resourcet-1.2.5:Control.Monad.Trans.Resource.Internal.ResourceT
                             IO

我遇到这个问题是因为我想使用的 monad 是用 Polysemy 创建的，有很多效果，但我想使用 Reader monad 来保持示例简单。

所以一般的问题是，如何在 Conduit Websocket 端点中使用自定义 monad？

解决方案

感谢 fghibellini 的提示，这是玩具示例的完整解决方案：

#!/usr/bin/env stack
{-
 stack --resolver lts-19.07 script --package servant --package servant-server
       --package servant-websockets --package polysemy --package aeson --package mtl
       --package wai --package warp --package conduit
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Conduit
import qualified Data.Conduit.List as CL
import Control.Monad.Except (ExceptT(ExceptT))
import Data.Aeson (ToJSON, FromJSON)
import Data.Char (toUpper)
import Data.Function ((&))
import GHC.Generics ( Generic )
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
import Polysemy ( runM, Sem, Members, Embed )
import Polysemy.Error ( runError, Error )
import Polysemy.Trace ( trace, traceToStdout, Trace )
import Servant
import Servant.API.WebSocketConduit (WebSocketConduit)
import Servant.Server

-- Dummy message
newtype Message = Message { content :: String } deriving (Show, Generic)

instance ToJSON Message
instance FromJSON Message

type MyApi = "toupper" :> ReqBody '[JSON] Message :> Post '[JSON] Message
            :<|> "ws-toupper" :> WebSocketConduit Message Message
            :<|> "ws-toupper-sem" :> WebSocketConduit Message Message


server :: Members '[Trace, Embed IO] r => ServerT MyApi (Sem r)
server = toupper :<|> wstoupper :<|> wstoupperWithSem

toupper :: Members '[Trace, Embed IO] r => Message -> Sem r Message
toupper (Message msg) = do
  trace $ "Received msg in the REST endpoint: " ++ msg
  return (Message . map toUpper $ msg)

wstoupper :: Monad m => ConduitT Message Message m ()
wstoupper = CL.map (\(Message msg) -> Message . map toUpper $ msg)

wstoupperWithSem :: ConduitT Message Message (ResourceT IO) ()
wstoupperWithSem = transPipe (liftIO . interpreter) semConduit
  where
    interpreter :: Sem '[Trace , Embed IO] a -> IO a
    interpreter sem = sem
      & traceToStdout
      & runM

    semConduit :: Members '[Trace, Embed IO] r => ConduitT Message Message (Sem r) ()
    semConduit = mapMC effect

    effect :: Members '[Trace] r => Message -> Sem r Message
    effect (Message msg) = do
      trace $ "Received msg through the WS: " ++ msg
      return (Message . map toUpper $ msg)

liftServer :: ServerT MyApi Handler
liftServer = hoistServer api interpreter server
  where
    interpreter :: Sem '[Trace, Error ServerError , Embed IO] a -> Handler a
    interpreter sem = sem
      & traceToStdout
      & runError
      & runM
      & liftHandler

    liftHandler = Handler . ExceptT


api :: Proxy MyApi
api = Proxy

app :: Application
app = serve api liftServer


main :: IO ()
main = do
  putStrLn "Starting server on http://localhost:8080"
  run 8080 app

Answer 1

WebSocketConduit 的 HasServer 实例开始于：

instance (FromJSON i, ToJSON o) => HasServer (WebSocketConduit i o) ctx where

  type ServerT (WebSocketConduit i o) m = Conduit i (ResourceT IO) o

link 到 source code

如您所见，monad 固定为 ResourceT IO。这就是您的示例无法编译的原因。

您可以忽略 ResourceT 部分，因为您可以轻松地将 IO 放入其中。所以你的任务归结为评估你的 monad 堆栈，直到你得到一个简单的 IO 操作。

为了评估您示例中的 ReaderT String 层，我们将使用 runReaderC :: Monad m => r -> ConduitT i o (ReaderT r m) res -> ConduitT i o m res。但通常你会使用任何“runs/evaluates”你的 Monad 到 IO.

以下代码可以正常编译：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Servant
import Data.Conduit
import Data.Aeson (Value)
import qualified Data.Conduit.List as CL
import Servant.API.WebSocketConduit
import Control.Monad.Reader
import Data.Conduit.Lift (runReaderC)


type WebSocketApi = "echo" :> WebSocketConduit Value Value

server :: Server WebSocketApi
server = transPipe lift $ runReaderC "your-reader-state" echo
 where
  echo :: Conduit Value (ReaderT String IO) Value
  echo = CL.map id

在 transPipe 下有一条关于将 monad transformeres 与管道一起使用的警告，您最好阅读一下。

更正

我刚刚发现你使用了 Reader String 而不是 ReaderT String IO。我将按原样保留答案，因为它说明了更常见的情况，但是对于 Reader String 你只需将 lift 替换为 (pure . runIdentity) 即可从 Identity 重新包装到IO.

如何在 servant-websocket 的管道端点中使用自己的 Monad？

How to use your own Monad in servant-websocket's conduit endpoint?

haskell

websocket

servant