Haskell Servant 获取当前路由 / URL 来自 Handler
Haskell Servant Get Current Route / URL From Handler
我想获取与我的处理程序相对应的当前路线。这是我的服务器模型，仅供参考：
type ServerAPI =
"route01" :> Get '[HTML] Text
:<|> "route02" :> "subroute" :> Get '[HTML] Text
:<|> "route03" :> Get '[HTML] Text
这里有一些处理程序：
route1and2Handler :: Handler Text
route1and2Handler = do
route <- getCurrentRoute
addVisitCountForRouteToDatabaseOrSomethingOfThatSort...
return template
route3Handler :: Handler Text
route3Handler = return "Hello, I'm route 03"
我的服务器：
server :: Server ServerAPI
server = route1and2Handler :<|> route1and2Handler :<|> route3Handler
所以，基本上我的 route1and2Handler 应该有一些获取当前路线的方法。我已经尝试将请求对象放入我的处理程序中，并通过实现 HasServer 实例从中提取 url ，如下所示：
data FullRequest
instance HasServer a => HasServer (FullRequest :> a) where
type Server (FullRequest :> a) = Request -> Server a
route Proxy subserver request respond =
route (Proxy :: Proxy a) (subserver request) request respond
[编辑] 我刚刚注意到我正在查看 api 旧版本的仆人，这不再有效。新 route 的类型签名为 route :: Proxy api -> Context context -> Delayed env (Server api) -> Router env，我真的看不出从这里获取 Request 的方法。
而不是将 route1and2Handler 类型签名设为 Request -> Handler Text，但我在尝试创建 HasServer 实例时遇到此错误：
`Server' is not a (visible) associated type of class `HasServer'
最后要指出的是，我的最终目标是从 Handler 中获取当前路线，在数据库中添加路线的访问计数只是为了示例目的。我对计算访问次数或类似内容的更好方法不感兴趣。
我不知道如何自动执行此操作，但可以 "manually" 使用 safeLink 函数来完成。
这个想法是，如果你有 API
type ServerAPI =
"route01" :> Get '[HTML] Text
:<|> "route02" :> "subroute" :> Get '[HTML] Text
:<|> Route3
type Route3 = "route03" :> Get '[HTML] Text
您可以将具有整个 API 的代理和具有特定路由的代理传递给 safeLink，并显示结果 URI:
show (safeLink (Proxy::Proxy ServerAPI) (Proxy::Proxy Route3))
如果路由有参数，你还需要传递handler获取的参数。例如：
type ServerAPI =
...
:<|> Route4
type Route4 = "route04" :> Capture "cap" Int :> Get '[JSON] Text
在 ghci 中：
ghci> :set -XKindSignatures -XDataKinds -XTypeOperators -XTypeFamilies
ghci> :type safeLink (Proxy::Proxy ServerAPI) (Proxy::Proxy Route4)
Int -> URI
您必须为每条路线执行此操作。
当您将 'route' 参数添加到您的处理程序时，您可以在为您的服务器组合处理程序时通过函数应用程序设置参数值。
基于您的示例：
type ServerAPI =
"route01" :> Get '[JSON] Text
:<|> "route02" :> "subroute" :> Get '[JSON] Text
:<|> "route03" :> Get '[JSON] Text
route1and2Handler :: String -> Handler Text
route1and2Handler route = do
-- addVisitCountForRouteToDatabaseOrSomethingOfThatSort...
return (pack route)
route3Handler :: Handler Text
route3Handler = return "Hello, I'm route 03"
server :: Server ServerAPI
server = route1and2Handler "route01" :<|> route1and2Handler "route02" :<|> route3Handler
或者，如果您真正感兴趣的是对所有路由的一些通用请求处理，那么通过在服务器和应用程序之间应用 'middleware' 可能更好地实现这一点。中间件（通常是 Application -> Application 类型）可以访问请求。有关 wai 中间件的示例，请参阅 wai-extra。
为所有请求执行日志记录的示例：
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
...
app :: Application
app = serve serverAPI server
main :: IO ()
main = run 8081 $ logStdoutDev app
一题有两题:
- 如何获取当前请求或URL?
- 如何获取电流 "route"?
请注意，URL（例如 /route12/42）与路线不同
（例如 `"route12" :> 捕获 "id" Int :> 获取 '[JSON] Int）。
让我们看看如何解决这两个问题
简短的语言编译指示和导入部分。
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Main where
import Data.Maybe (fromMaybe)
import Control.Monad.IO.Class (liftIO)
import System.Environment (getArgs)
import GHC.Generics (to, from, M1 (..), K1 (..), (:*:) (..))
-- for "unsafe" vault key creation
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Vault.Lazy as V
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Servant
import Servant.API.Generic
import Servant.Server.Generic
import Servant.Server.Internal.RoutingApplication (passToServer)
如何获取当前 Request 对象或 URL
将当前 WAI Request 传递给处理程序实际上非常容易。
这是 "lazy" 方法，我们在请求中要求 "everything"，
我们必须在处理程序中小心（例如，我们不能触摸 requestBody）。
此外，此 "combinator" 将实现与 wai 服务器实现联系起来，
这是一个实现细节
（servant-server 中没有其他内容公开 wai 内部结构，Raw 除外）。
想法是Server (Wai.Request :> api) = Wai.Request -> Server api。
如果我们想象一下我们有这样的功能，
我们可以写，使用 Servant.API.Generic（参见 "Using generics" 食谱食谱）：
data Routes1 route = Routes1
{ route11 :: route :- Wai.Request :> "route1" :> Get '[JSON] Int
, route12 :: route :- Wai.Request :> "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
routes1 :: Routes1 AsServer
routes1 = Routes1
{ route11 = \req -> liftIO $ do
let p = Wai.rawPathInfo req
BS8.putStrLn p
return (BS8.length p)
, route12 = \req i -> liftIO $ do
let p = Wai.rawPathInfo req
BS8.putStrLn p
return (succ i)
}
app1 :: Application
app1 = genericServe routes1
我们定义一个Routes1数据类型，实现Routes1 AsServer值并转
进入 wai 的 Application。然而，要编译这个例子，我们需要一个
附加实例。我们使用 internal passToServer 组合子
route.
的实施
instance HasServer api ctx => HasServer (Wai.Request :> api) ctx where
type ServerT (Wai.Request :> api) m = Wai.Request -> ServerT api m
hoistServerWithContext _ pc nt s =
hoistServerWithContext (Proxy :: Proxy api) pc nt . s
route _ ctx d = route (Proxy :: Proxy api) ctx $
passToServer d id
这个解决方案是很好的快速解决方案，但可以说还有更好的方法。
特定组合器
我们可能会注意到我们的两个处理程序都使用 Wai.rawPathInto req 调用。
这应该提醒我们。特定的组合器更优雅。
在核心框架之外创建新组合器的能力，
是servant.
的设计原则之一
data RawPathInfo
instance HasServer api ctx => HasServer (RawPathInfo :> api) ctx where
type ServerT (RawPathInfo :> api) m = BS8.ByteString -> ServerT api m
hoistServerWithContext _ pc nt s =
hoistServerWithContext (Proxy :: Proxy api) pc nt . s
route _ ctx d = route (Proxy :: Proxy api) ctx $
passToServer d Wai.rawPathInfo
使用新的 RawPathInfo 组合器，我们可以重新实现我们的应用程序：
data Routes2 route = Routes2
{ route21 :: route :- RawPathInfo :> "route1" :> Get '[JSON] Int
, route22 :: route :- RawPathInfo :> "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
routes2 :: Routes2 AsServer
routes2 = Routes2
{ route21 = \p -> liftIO $ do
BS8.putStrLn p
return (BS8.length p)
, route22 = \p i -> liftIO $ do
BS8.putStrLn p
return (succ i)
}
app2 :: Application
app2 = genericServe routes2
此版本的声明性稍强，处理程序的限制性更强。
我们将 rawPathInfo 选择器从处理程序移动到组合器实现，
删除重复。
使用Vault
wai Request 中的 vault 值鲜为人知或未被使用。
但在这种情况下它可能很有用。
Using WAI's vault for fun and profit 博客 post 中解释了 Vault。
它填补了强类型 Request 的 "dynamic" 空白：我们可以将任意数据附加到请求中，
在动态类型语言的 Web 框架中很常见。
由于 servant-server 基于 wai，使用 vault 是第三个答案
到问题的第一部分。
我们（不安全地）为保险库创建了一个密钥：
rpiKey :: V.Key BS8.ByteString
rpiKey = unsafePerformIO V.newKey
然后我们创建一个中间件，它将把rawPathInfo放入vault。
middleware :: Wai.Middleware
middleware app req respond = do
let vault' = V.insert rpiKey (Wai.rawPathInfo req) (Wai.vault req)
req' = req { Wai.vault = vault' }
app req' respond
我们使用它制作了应用程序的第三个变体。
请注意，我们的值可能不在保险库中，
那是小的功能回归。
data Routes3 route = Routes3
{ route31 :: route :- Vault :> "route1" :> Get '[JSON] Int
, route32 :: route :- Vault :> "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
routes3 :: Routes3 AsServer
routes3 = Routes3
{ route31 = \v -> liftIO $ do
let p = fromMaybe "?" $ V.lookup rpiKey v
BS8.putStrLn p
return (BS8.length p)
, route32 = \v i -> liftIO $ do
let p = fromMaybe "?" $ V.lookup rpiKey v
BS8.putStrLn p
return (succ i)
}
app3 :: Application
app3 = middleware $ genericServe routes3
注意：vault 可用于将信息从中间件传递到处理程序
从处理程序到中间件。例如，可以进行身份验证
完全在中间件中，用户信息存储在保险库中
要使用的处理程序。
如何获取当前路由?
一道题的第二部分，是如何获取当前路线。
有事，我们可以弄route2/:id出来吗？
请注意，处理程序是 匿名的 ，函数也是。
例如。要编写 递归 匿名函数，我们可以使用 fix 组合子。
我们可以使用类似的东西来传递 "route into itself"，
使用 Servant.API.Generics 我们也可以减少样板文件。
我们从普通的 Routes4 数据结构开始。
data Routes4 route = Routes4
{ route41 :: route :- "route1" :> Get '[JSON] Int
, route42 :: route :- "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
但我们将使用不同的 模式 ，而不是创建 Routes4 AsServer 值。
AsRecServer route 是一个处理程序，它以 route :- api 作为第一个
争论。在本例中我们使用 HasLink'，但 reader 可以自由使用其他
自动解释，例如servant-client做代理！
data AsRecServer route
instance GenericMode (AsRecServer route) where
type AsRecServer route :- api = (route :- api) -> (AsServer :- api)
routes4 :: Routes4 (AsRecServer (AsLink Link))
routes4 = Routes4
{ route41 = \l -> liftIO $ do
print l
return 42
, route42 = \l i -> liftIO $ do
print (l i)
return i
}
app4 :: Application
app4 = genericRecServe routes4
用法很简单，可惜实现不是。
毛茸茸的
genericRecServe 的实施令人生畏。
缺少的位是一个函数 genericHoist。
简而言之，给定一个可以将所有 api 的 modeA :- api 转换为 modeB :- api 的函数，
genericHoist 将 routes modeA 转换为 routes modeB。
也许这个函数应该存在于 Servant.API.Generic?
genericHoist
:: ( GenericMode modeA, GenericMode modeB
, Generic (routes modeA), Generic (routes modeB)
, GServantHoist c api modeA modeB (Rep (routes modeA)) (Rep (routes modeB))
)
=> Proxy modeA -> Proxy modeB -> Proxy c -> Proxy api
-> (forall api'. c api' => Proxy api' -> (modeA :- api') -> (modeB :- api'))
-> routes modeA -> routes modeB
genericHoist pa pb pc api nt = to . gservantHoist pa pb pc api nt . from
genericRecServe 是 genericHoist 预组合了 genericServe 的变体。
单线执行，给定一堵墙。
genericRecServe
:: forall routes.
( HasServer (ToServantApi routes) '[]
, GenericServant routes AsApi
, GenericServant routes AsServer
, GenericServant routes (AsRecServer (AsLink Link))
, Server (ToServantApi routes) ~ ToServant routes AsServer
, GServantHoist
HasLink'
(ToServantApi routes)
(AsRecServer (AsLink Link))
AsServer
(Rep (routes (AsRecServer (AsLink Link))))
(Rep (routes AsServer))
)
=> routes (AsRecServer (AsLink Link)) -> Application
genericRecServe
= serve (Proxy :: Proxy (ToServantApi routes))
. toServant
. genericHoist
(Proxy :: Proxy (AsRecServer (AsLink Link)))
(Proxy :: Proxy AsServer)
(Proxy :: Proxy HasLink')
(genericApi (Proxy :: Proxy routes))
(\p f -> f $ safeLink p p)
我们使用单实例-class 技巧使部分适用 HasLink.
class (IsElem api api, HasLink api) => HasLink' api
instance (IsElem api api, HasLink api) => HasLink' api
genericHoist 的主力是 gservantHoist
在 Rep 个路由结构上。
请务必注意 c 和 api 参数是 class 参数。
这让我们可以在实例中约束它们。
class GServantHoist c api modeA modeB f g where
gservantHoist
:: Proxy modeA -> Proxy modeB -> Proxy c -> Proxy api
-> (forall api'. c api' => Proxy api' -> (modeA :- api') -> (modeB :- api'))
-> f x -> g x
M1（元数据）和:*:（产品）的实例很简单
传递，你会期望的东西：
instance
GServantHoist c api modeA modeB f g
=>
GServantHoist c api modeA modeB (M1 i j f) (M1 i' j' g)
where
gservantHoist pa pb pc api nt
= M1
. gservantHoist pa pb pc api nt
. unM1
instance
( GServantHoist c apiA modeA modeB f f'
, GServantHoist c apiB modeA modeB g g'
) =>
GServantHoist c (apiA :<|> apiB) modeA modeB (f :*: g) (f' :*: g')
where
gservantHoist pa pb pc _ nt (f :*: g) =
gservantHoist pa pb pc (Proxy :: Proxy apiA) nt f
:*:
gservantHoist pa pb pc (Proxy :: Proxy apiB) nt g
叶子 K1 的实现说明了为什么我们需要 c 和 api
作为 class 参数：这里我们需要 c api 和 "coherence" 条件，
所以 api、modeA、modeB、x 和 y 匹配。
instance
( c api, (modeA :- api) ~ x, (modeB :- api) ~ y )
=> GServantHoist c api modeA modeB (K1 i x) (K1 i y)
where
gservantHoist _pa _pb _pc api nt
= K1
. nt api
. unK1
结论
使用类似的 Generic 方法，我们可以对处理程序进行各种转换。
例如，我们可以将普通路由包装在 servant "middleware" 中，这将
将路由信息放入 vault，该信息可能会被 wai 使用
Middleware 收集统计数据。这样我们就可以做一个改进的版本
servant-ekg，目前 servant-ekg 可能会因重叠路线而感到困惑。
主要用于测试
main :: IO ()
main = do
args <- getArgs
case args of
("run1":_) -> run app1
("run2":_) -> run app2
("run3":_) -> run app3
("run4":_) -> run app4
_ -> putStrLn "To run, pass 'run1' argument: cabal new-run cookbook-generic run"
where
run app = do
putStrLn "Starting cookbook-current-route at http://localhost:8000"
Warp.run 8000 app
我想获取与我的处理程序相对应的当前路线。这是我的服务器模型，仅供参考：
type ServerAPI =
"route01" :> Get '[HTML] Text
:<|> "route02" :> "subroute" :> Get '[HTML] Text
:<|> "route03" :> Get '[HTML] Text
这里有一些处理程序：
route1and2Handler :: Handler Text
route1and2Handler = do
route <- getCurrentRoute
addVisitCountForRouteToDatabaseOrSomethingOfThatSort...
return template
route3Handler :: Handler Text
route3Handler = return "Hello, I'm route 03"
我的服务器：
server :: Server ServerAPI
server = route1and2Handler :<|> route1and2Handler :<|> route3Handler
所以，基本上我的 route1and2Handler 应该有一些获取当前路线的方法。我已经尝试将请求对象放入我的处理程序中，并通过实现 HasServer 实例从中提取 url ，如下所示：
data FullRequest
instance HasServer a => HasServer (FullRequest :> a) where
type Server (FullRequest :> a) = Request -> Server a
route Proxy subserver request respond =
route (Proxy :: Proxy a) (subserver request) request respond
[编辑] 我刚刚注意到我正在查看 api 旧版本的仆人，这不再有效。新 route 的类型签名为 route :: Proxy api -> Context context -> Delayed env (Server api) -> Router env，我真的看不出从这里获取 Request 的方法。
而不是将 route1and2Handler 类型签名设为 Request -> Handler Text，但我在尝试创建 HasServer 实例时遇到此错误：
`Server' is not a (visible) associated type of class `HasServer'
最后要指出的是，我的最终目标是从 Handler 中获取当前路线，在数据库中添加路线的访问计数只是为了示例目的。我对计算访问次数或类似内容的更好方法不感兴趣。
我不知道如何自动执行此操作，但可以 "manually" 使用 safeLink 函数来完成。
这个想法是，如果你有 API
type ServerAPI =
"route01" :> Get '[HTML] Text
:<|> "route02" :> "subroute" :> Get '[HTML] Text
:<|> Route3
type Route3 = "route03" :> Get '[HTML] Text
您可以将具有整个 API 的代理和具有特定路由的代理传递给 safeLink，并显示结果 URI:
show (safeLink (Proxy::Proxy ServerAPI) (Proxy::Proxy Route3))
如果路由有参数，你还需要传递handler获取的参数。例如：
type ServerAPI =
...
:<|> Route4
type Route4 = "route04" :> Capture "cap" Int :> Get '[JSON] Text
在 ghci 中：
ghci> :set -XKindSignatures -XDataKinds -XTypeOperators -XTypeFamilies
ghci> :type safeLink (Proxy::Proxy ServerAPI) (Proxy::Proxy Route4)
Int -> URI
您必须为每条路线执行此操作。
当您将 'route' 参数添加到您的处理程序时，您可以在为您的服务器组合处理程序时通过函数应用程序设置参数值。
基于您的示例：
type ServerAPI =
"route01" :> Get '[JSON] Text
:<|> "route02" :> "subroute" :> Get '[JSON] Text
:<|> "route03" :> Get '[JSON] Text
route1and2Handler :: String -> Handler Text
route1and2Handler route = do
-- addVisitCountForRouteToDatabaseOrSomethingOfThatSort...
return (pack route)
route3Handler :: Handler Text
route3Handler = return "Hello, I'm route 03"
server :: Server ServerAPI
server = route1and2Handler "route01" :<|> route1and2Handler "route02" :<|> route3Handler
或者，如果您真正感兴趣的是对所有路由的一些通用请求处理，那么通过在服务器和应用程序之间应用 'middleware' 可能更好地实现这一点。中间件（通常是 Application -> Application 类型）可以访问请求。有关 wai 中间件的示例，请参阅 wai-extra。
为所有请求执行日志记录的示例：
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
...
app :: Application
app = serve serverAPI server
main :: IO ()
main = run 8081 $ logStdoutDev app
一题有两题:
- 如何获取当前请求或URL?
- 如何获取电流 "route"?
请注意，URL（例如 /route12/42）与路线不同
（例如 `"route12" :> 捕获 "id" Int :> 获取 '[JSON] Int）。
让我们看看如何解决这两个问题
简短的语言编译指示和导入部分。
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Main where
import Data.Maybe (fromMaybe)
import Control.Monad.IO.Class (liftIO)
import System.Environment (getArgs)
import GHC.Generics (to, from, M1 (..), K1 (..), (:*:) (..))
-- for "unsafe" vault key creation
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Vault.Lazy as V
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Servant
import Servant.API.Generic
import Servant.Server.Generic
import Servant.Server.Internal.RoutingApplication (passToServer)
如何获取当前 Request 对象或 URL
将当前 WAI Request 传递给处理程序实际上非常容易。
这是 "lazy" 方法，我们在请求中要求 "everything"，
我们必须在处理程序中小心（例如，我们不能触摸 requestBody）。
此外，此 "combinator" 将实现与 wai 服务器实现联系起来，
这是一个实现细节
（servant-server 中没有其他内容公开 wai 内部结构，Raw 除外）。
想法是Server (Wai.Request :> api) = Wai.Request -> Server api。
如果我们想象一下我们有这样的功能，
我们可以写，使用 Servant.API.Generic（参见 "Using generics" 食谱食谱）：
data Routes1 route = Routes1
{ route11 :: route :- Wai.Request :> "route1" :> Get '[JSON] Int
, route12 :: route :- Wai.Request :> "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
routes1 :: Routes1 AsServer
routes1 = Routes1
{ route11 = \req -> liftIO $ do
let p = Wai.rawPathInfo req
BS8.putStrLn p
return (BS8.length p)
, route12 = \req i -> liftIO $ do
let p = Wai.rawPathInfo req
BS8.putStrLn p
return (succ i)
}
app1 :: Application
app1 = genericServe routes1
我们定义一个Routes1数据类型，实现Routes1 AsServer值并转
进入 wai 的 Application。然而，要编译这个例子，我们需要一个
附加实例。我们使用 internal passToServer 组合子
route.
instance HasServer api ctx => HasServer (Wai.Request :> api) ctx where
type ServerT (Wai.Request :> api) m = Wai.Request -> ServerT api m
hoistServerWithContext _ pc nt s =
hoistServerWithContext (Proxy :: Proxy api) pc nt . s
route _ ctx d = route (Proxy :: Proxy api) ctx $
passToServer d id
这个解决方案是很好的快速解决方案，但可以说还有更好的方法。
特定组合器
我们可能会注意到我们的两个处理程序都使用 Wai.rawPathInto req 调用。
这应该提醒我们。特定的组合器更优雅。
在核心框架之外创建新组合器的能力，
是servant.
data RawPathInfo
instance HasServer api ctx => HasServer (RawPathInfo :> api) ctx where
type ServerT (RawPathInfo :> api) m = BS8.ByteString -> ServerT api m
hoistServerWithContext _ pc nt s =
hoistServerWithContext (Proxy :: Proxy api) pc nt . s
route _ ctx d = route (Proxy :: Proxy api) ctx $
passToServer d Wai.rawPathInfo
使用新的 RawPathInfo 组合器，我们可以重新实现我们的应用程序：
data Routes2 route = Routes2
{ route21 :: route :- RawPathInfo :> "route1" :> Get '[JSON] Int
, route22 :: route :- RawPathInfo :> "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
routes2 :: Routes2 AsServer
routes2 = Routes2
{ route21 = \p -> liftIO $ do
BS8.putStrLn p
return (BS8.length p)
, route22 = \p i -> liftIO $ do
BS8.putStrLn p
return (succ i)
}
app2 :: Application
app2 = genericServe routes2
此版本的声明性稍强，处理程序的限制性更强。
我们将 rawPathInfo 选择器从处理程序移动到组合器实现，
删除重复。
使用Vault
wai Request 中的 vault 值鲜为人知或未被使用。
但在这种情况下它可能很有用。
Using WAI's vault for fun and profit 博客 post 中解释了 Vault。
它填补了强类型 Request 的 "dynamic" 空白：我们可以将任意数据附加到请求中，
在动态类型语言的 Web 框架中很常见。
由于 servant-server 基于 wai，使用 vault 是第三个答案
到问题的第一部分。
我们（不安全地）为保险库创建了一个密钥：
rpiKey :: V.Key BS8.ByteString
rpiKey = unsafePerformIO V.newKey
然后我们创建一个中间件，它将把rawPathInfo放入vault。
middleware :: Wai.Middleware
middleware app req respond = do
let vault' = V.insert rpiKey (Wai.rawPathInfo req) (Wai.vault req)
req' = req { Wai.vault = vault' }
app req' respond
我们使用它制作了应用程序的第三个变体。 请注意，我们的值可能不在保险库中， 那是小的功能回归。
data Routes3 route = Routes3
{ route31 :: route :- Vault :> "route1" :> Get '[JSON] Int
, route32 :: route :- Vault :> "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
routes3 :: Routes3 AsServer
routes3 = Routes3
{ route31 = \v -> liftIO $ do
let p = fromMaybe "?" $ V.lookup rpiKey v
BS8.putStrLn p
return (BS8.length p)
, route32 = \v i -> liftIO $ do
let p = fromMaybe "?" $ V.lookup rpiKey v
BS8.putStrLn p
return (succ i)
}
app3 :: Application
app3 = middleware $ genericServe routes3
注意：vault 可用于将信息从中间件传递到处理程序
从处理程序到中间件。例如，可以进行身份验证
完全在中间件中，用户信息存储在保险库中
要使用的处理程序。
如何获取当前路由?
一道题的第二部分，是如何获取当前路线。
有事，我们可以弄route2/:id出来吗？
请注意，处理程序是 匿名的 ，函数也是。
例如。要编写 递归 匿名函数，我们可以使用 fix 组合子。
我们可以使用类似的东西来传递 "route into itself"，
使用 Servant.API.Generics 我们也可以减少样板文件。
我们从普通的 Routes4 数据结构开始。
data Routes4 route = Routes4
{ route41 :: route :- "route1" :> Get '[JSON] Int
, route42 :: route :- "route2" :> Capture "id" Int :> Get '[JSON] Int
}
deriving (Generic)
但我们将使用不同的 模式 ，而不是创建 Routes4 AsServer 值。
AsRecServer route 是一个处理程序，它以 route :- api 作为第一个
争论。在本例中我们使用 HasLink'，但 reader 可以自由使用其他
自动解释，例如servant-client做代理！
data AsRecServer route
instance GenericMode (AsRecServer route) where
type AsRecServer route :- api = (route :- api) -> (AsServer :- api)
routes4 :: Routes4 (AsRecServer (AsLink Link))
routes4 = Routes4
{ route41 = \l -> liftIO $ do
print l
return 42
, route42 = \l i -> liftIO $ do
print (l i)
return i
}
app4 :: Application
app4 = genericRecServe routes4
用法很简单，可惜实现不是。
毛茸茸的
genericRecServe 的实施令人生畏。
缺少的位是一个函数 genericHoist。
简而言之，给定一个可以将所有 api 的 modeA :- api 转换为 modeB :- api 的函数，
genericHoist 将 routes modeA 转换为 routes modeB。
也许这个函数应该存在于 Servant.API.Generic?
genericHoist
:: ( GenericMode modeA, GenericMode modeB
, Generic (routes modeA), Generic (routes modeB)
, GServantHoist c api modeA modeB (Rep (routes modeA)) (Rep (routes modeB))
)
=> Proxy modeA -> Proxy modeB -> Proxy c -> Proxy api
-> (forall api'. c api' => Proxy api' -> (modeA :- api') -> (modeB :- api'))
-> routes modeA -> routes modeB
genericHoist pa pb pc api nt = to . gservantHoist pa pb pc api nt . from
genericRecServe 是 genericHoist 预组合了 genericServe 的变体。
单线执行，给定一堵墙。
genericRecServe
:: forall routes.
( HasServer (ToServantApi routes) '[]
, GenericServant routes AsApi
, GenericServant routes AsServer
, GenericServant routes (AsRecServer (AsLink Link))
, Server (ToServantApi routes) ~ ToServant routes AsServer
, GServantHoist
HasLink'
(ToServantApi routes)
(AsRecServer (AsLink Link))
AsServer
(Rep (routes (AsRecServer (AsLink Link))))
(Rep (routes AsServer))
)
=> routes (AsRecServer (AsLink Link)) -> Application
genericRecServe
= serve (Proxy :: Proxy (ToServantApi routes))
. toServant
. genericHoist
(Proxy :: Proxy (AsRecServer (AsLink Link)))
(Proxy :: Proxy AsServer)
(Proxy :: Proxy HasLink')
(genericApi (Proxy :: Proxy routes))
(\p f -> f $ safeLink p p)
我们使用单实例-class 技巧使部分适用 HasLink.
class (IsElem api api, HasLink api) => HasLink' api
instance (IsElem api api, HasLink api) => HasLink' api
genericHoist 的主力是 gservantHoist
在 Rep 个路由结构上。
请务必注意 c 和 api 参数是 class 参数。
这让我们可以在实例中约束它们。
class GServantHoist c api modeA modeB f g where
gservantHoist
:: Proxy modeA -> Proxy modeB -> Proxy c -> Proxy api
-> (forall api'. c api' => Proxy api' -> (modeA :- api') -> (modeB :- api'))
-> f x -> g x
M1（元数据）和:*:（产品）的实例很简单
传递，你会期望的东西：
instance
GServantHoist c api modeA modeB f g
=>
GServantHoist c api modeA modeB (M1 i j f) (M1 i' j' g)
where
gservantHoist pa pb pc api nt
= M1
. gservantHoist pa pb pc api nt
. unM1
instance
( GServantHoist c apiA modeA modeB f f'
, GServantHoist c apiB modeA modeB g g'
) =>
GServantHoist c (apiA :<|> apiB) modeA modeB (f :*: g) (f' :*: g')
where
gservantHoist pa pb pc _ nt (f :*: g) =
gservantHoist pa pb pc (Proxy :: Proxy apiA) nt f
:*:
gservantHoist pa pb pc (Proxy :: Proxy apiB) nt g
叶子 K1 的实现说明了为什么我们需要 c 和 api
作为 class 参数：这里我们需要 c api 和 "coherence" 条件，
所以 api、modeA、modeB、x 和 y 匹配。
instance
( c api, (modeA :- api) ~ x, (modeB :- api) ~ y )
=> GServantHoist c api modeA modeB (K1 i x) (K1 i y)
where
gservantHoist _pa _pb _pc api nt
= K1
. nt api
. unK1
结论
使用类似的 Generic 方法，我们可以对处理程序进行各种转换。
例如，我们可以将普通路由包装在 servant "middleware" 中，这将
将路由信息放入 vault，该信息可能会被 wai 使用
Middleware 收集统计数据。这样我们就可以做一个改进的版本
servant-ekg，目前 servant-ekg 可能会因重叠路线而感到困惑。
主要用于测试
main :: IO ()
main = do
args <- getArgs
case args of
("run1":_) -> run app1
("run2":_) -> run app2
("run3":_) -> run app3
("run4":_) -> run app4
_ -> putStrLn "To run, pass 'run1' argument: cabal new-run cookbook-generic run"
where
run app = do
putStrLn "Starting cookbook-current-route at http://localhost:8000"
Warp.run 8000 app