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

我試圖弄清楚如何在庫提供的端點ConduitT定義中使用自定義 monad。WebSocketConduitservant-websocket

假設我有這個 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

uj5u.com熱心網友回復：

的HasServer實體WebSocketConduit以：

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

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

鏈接到源代碼

如您所見，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. 但通常你會使用任何“運行/評估”你的 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 變壓器的警告，你最好閱讀一下。

更正

我才意識到你用過Reader String而不是ReaderT String IO。我將按原樣保留答案，因為它說明了一個更常見的場景，但是Reader String您只需替換lift為(pure . runIdentity)to rewrap from Identityto IO。

標籤：哈斯克尔 网络套接字 仆人

上一篇：給定條件查找串列的最后一個元素

下一篇：當您沒有輸入引數來告訴您型別時，根據型別創建一個事物陣列