如何选择性地捕获Haskellservant中的路径段？

Question

我需要以向后兼容的方式在我的

servant

应用程序中引入内部化。我希望将语言代码作为“可选”路径段。如果第一个路径段来自已知的语言代码列表，则使用该语言，否则默认为Nothing（处理程序/服务器会将其解释为某种默认语言）。

/some/path => myHandler Nothing
/en/some/path => myHanddler (Just "en")
/fr/some/path => myHandler (Just "fr")

为了避免编写以下样板......

每个端点将有两个端点：一个带有语言代码段，另一个不带

• 因此，服务器/处理程序还需要有两种变体——一种带有语言代码，另一种不带有语言代码
...我想提出一个仆人组合器，它“偷看”

head $ pathInfo req

，如果它看起来像语言代码，它会捕获它，否则它会沿着

Nothing

传递到子服务器。我想出了以下方法，但这不起作用，因为它总是期望

pathSegment

存在。它不是在“可选”的基础上捕获它。

data HostWithLocale = HostWithLocale

instance (HasServer api context) => HasServer (HostWithLocale :> api) context where
  type ServerT (HostWithLocale :> api) m = (Hostname, Maybe LanguageCode) -> ServerT api m
  
  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s  

  route _ context server = 
    CaptureRouter [hint] $ route (Proxy :: Proxy api) context subserver
    where
      hint = CaptureHint "language" (typeRep (Proxy :: Proxy (Hostname, Maybe LanguageCode)))
      subserver = addCapture server $ \pathSegment -> withRequest $ \req -> 
        case DL.lookup (fromString "Host") (requestHeaders req) of
          Nothing -> 
            delayedFail err406
          Just hname -> 
            if Prelude.not (isWhiteListedDomain hname)
              then delayedFail err406
              else if pathSegment `DL.elem` knownLanguageCodes
                then pure $ (toS hname, Just $ LanguageCode pathSegment)
                else pure $ (toS hname, Nothing)

isWhiteListedDomain :: C8.ByteString -> Bool
isWhiteListedDomain = undefined 
    
knownLanguageCodes :: [Text]
knownLanguageCodes = undefined

因此，服务器/处理程序还需要有两种变体——一种带有语言代码，另一种不带有语言代码

Answer 1

这两个变体可以在没有太多重复的情况下定义，并且无需定义新的

HasServer

实例。

想象一下，您有一个与 Servant API 定义相对应的

SomeApi

类型。它可能非常复杂，有很多路线，无论如何。可以为该 API 提供服务的值的类型为

Server SomeApi

。

假设现在我们定义这个捕获语言路径段的API：

type SomeApiI18n = Capture "lang" Text :> SomeApi

该 API 可以通过

Server SomeApiI18n

 类型的值提供服务。但是，如果我们稍微扩展 

Server

类型家庭应用程序，该类型将相当于

Text -> Server SomeApi

。现在假设我们有一个类型为

someServerI18n

的值

Text -> Server SomeApi

，并希望用它来提供

SomeApi

（非本地化版本）。如何？非常简单，我们只需应用默认语言即可：

someServer' :: Server SomeApi
someServer' = someServerI18n "en"

现在，假设您有一个组合 API，例如

type FullApi = SomeApi :<|> SomeApiI18n

可以这样吃：

fullApiServer :: Server FullApi
fullApiServer = someServerI18N "en" :<|> someServerI18N

无需调整

SomeApi

中的每条路线，或定义两个完全不同的服务器实现。