如何在自定義servant處理程序中響應HTTP狀態？

Question

我創建了一個自定義的僕人處理

type ServiceSet = TVar (M.Map String [MicroService]) 
type LocalHandler = ReaderT ServiceSet IO 

但我沒能找到一種方法來響應一個404未找到的狀態代碼，客戶端在以下功能：

getService :: String -> LocalHandler MicroService 
getService sn = do 
    tvar <- ask 
    ms <- liftIO $ do 
    sl <- atomically $ do 
     sm <- readTVar tvar 
     return $ case M.lookup sn sm of 
     Nothing -> [] 
     Just sl -> sl 
    let n = length sl 
    i <- randomRIO (0, n - 1) 
    return $ if n == 0 
     then Nothing 
     else Just . head . drop i $ sl 
    case ms of 
    Nothing -> ??? -- throwError err404 
    Just ms' -> return ms' 

如何發送404個狀態代碼在???？

Answer 1

您需要將ExceptT添加到您的monad變換堆棧中。目前，只有ReaderT，沒有辦法對拋出錯誤的概念進行編碼。

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

module Lib where 

import Control.Monad.Except 
import Control.Monad.Reader 
import Data.Maybe 
import Data.Map 
import GHC.Conc 
import Prelude hiding (lookup) 
import Servant.API 
import Servant.Server 
import System.Random 

type API = 
    Capture "name" String :> Get '[JSON] Int 

type World = 
    TVar (Map String [Int]) 

type Effects = 
    ExceptT ServantErr (ReaderT World IO) 

server :: World -> Server API 
server world = 
    enter (Nat transform) get 
    where 
    transform :: Effects a -> ExceptT ServantErr IO a 
    transform (ExceptT foo) = 
     ExceptT $ runReaderT foo world 

get :: String -> Effects Int 
get sn = do 
    tvar <- ask 
    ms <- liftIO $ do 
    sl <- atomically $ do 
     sm <- readTVar tvar 
     return (fromMaybe [] (lookup sn sm)) 
    let n = length sl 
    i <- randomRIO (0, n - 1) 
    return $ if n == 0 
     then Nothing 
     else Just . head . drop i $ sl 
    case ms of 
    Nothing -> 
     throwError err404 
    Just ms' -> 
     return ms' 

隨着ExceptT ServantErr . ReaderT (TVar ...)你再throwError err404可以，這僕人將趕上並使用返回一個HTTP 404的自然轉化ExceptT ServantErr . ReaderT (TVar ...) :~> ExceptT ServantErr然後就可以展開，從而以排出讀者重新包裝效果。總而言之，不是更多的代碼。