Haskell Servant 和 MTL 应用程序风格

Question

在我观看了 George Wilson 的精彩演讲（Next Level MTL https://github.com/gwils/next-level-mtl-with-classy-optics/blob/master/Slides.pdf）之后，我尝试创建使用 MTL 的应用程序风格设计并决定使用servant，看起来这个库不太适合这样的设计。
\n下面的代码无法编译，因为我无法将m转换为 Handler。

\n\n

getItems :: (MonadIO m, MonadReader r m, HasNetworkConfig r) => m [Item]\ngetItems =\n   return [Item "foo" "bar"]\n\nmkApp :: Application\nmkApp = serve itemApi getItems\n

\n\n

您可以在这里找到完整的示例：https ://github.com/paweln1986/ServantMTLStackOverflowExample

\n\n

是否可以将任何 monad 与servant一起使用？如何实现这一目标？我尝试使用 hoistServer 但没有成功。你知道我想念这里什么吗？

\n\n

编译错误：

\n\n

   \xe2\x80\xa2 No instance for (MonadReader r0 Handler)\n    arising from a use of \xe2\x80\x98getItems\xe2\x80\x99\n   \xe2\x80\xa2 In the second argument of \xe2\x80\x98serve\xe2\x80\x99, namely \xe2\x80\x98getItems\xe2\x80\x99\n     In the expression: serve itemApi getItems\n     In an equation for \xe2\x80\x98mkApp\xe2\x80\x99: mkApp = serve itemApi getItems\n   |\n40 | mkApp = serve itemApi getItems\n   |                       ^^^^^^^^\n

\n\n

更短的例子：

\n\n

type ReaderAPI = "ep1" :> Get \'[JSON] Int :<|> "ep2" :> Get \'[JSON] String    :<|> Raw :<|> EmptyAPI\n\nreaderApi = Proxy :: Proxy ReaderAPI\n\nreaderServer :: (MonadIO m, HasNetworkConfig r, MonadReader r m) => ServerT ReaderAPI (AppT m)\nreaderServer = return 1797 :<|> view (networkConfig . host) :<|> Tagged (error "raw server") :<|> emptyServer\n\nnt x = return undefined\n\nmainServer = hoistServer readerApi nt readerServer :: Server ReaderAPI\n

\n\n

这给了我下面的编译错误

\n\n

    \xe2\x80\xa2 Ambiguous type variable \xe2\x80\x98m0\xe2\x80\x99 arising from a use of \xe2\x80\x98readerServer\xe2\x80\x99\n  prevents the constraint \xe2\x80\x98(MonadIO m0)\xe2\x80\x99 from being solved.\n  Probable fix: use a type annotation to specify what \xe2\x80\x98m0\xe2\x80\x99 should be.\n  These potential instances exist:\n    instance [safe] MonadIO IO -- Defined in \xe2\x80\x98Control.Monad.IO.Class\xe2\x80\x99\n    instance MonadIO m => MonadIO (AppT m) -- Defined in \xe2\x80\x98Types\xe2\x80\x99\n    instance MonadIO Handler\n      -- Defined in \xe2\x80\x98Servant.Server.Internal.Handler\xe2\x80\x99\n    ...plus 18 instances involving out-of-scope types\n    (use -fprint-potential-instances to see them all)\n\xe2\x80\xa2 In the third argument of \xe2\x80\x98hoistServer\xe2\x80\x99, namely \xe2\x80\x98readerServer\xe2\x80\x99\n  In the expression:\n      hoistServer readerApi nt readerServer :: Server ReaderAPI\n  In an equation for \xe2\x80\x98mainServer\xe2\x80\x99:\n      mainServer\n        = hoistServer readerApi nt readerServer :: Server ReaderAPI\n   |\n64 | mainServer = hoistServer readerApi nt readerServer :: Server ReaderAPI\n   |                                       ^^^^^^^^^^^^\n

\n

Answer 1

最后我设法解决了我的问题。

run :: (MonadIO m, MonadReader r m, HasNetworkConfig r) => AppConfig -> m ()
run config = do
  serverPort <- view (networkConfig . port)
  let settings =
        setPort serverPort $
        setBeforeMainLoop (liftIO $ hPutStrLn stderr ("listening on port " ++ show serverPort)) defaultSettings
  liftIO $ runSettings settings (mainServer config)

printM :: (MonadIO m, Show a) => a -> m ()
printM a = liftIO $ print a

type ReaderAPI = "ep1" :> Get '[ JSON] String :<|> "ep2" :> Get '[ JSON] String :<|> Raw :<|> EmptyAPI

readerApi :: Proxy ReaderAPI
readerApi = Proxy :: Proxy ReaderAPI

fromConfig :: (Functor m, MonadReader r m, HasNetworkConfig r) => m String
fromConfig = view (networkConfig . host)

rawValue :: (Applicative m) => m String
rawValue = pure "1797"

readerServer :: (Monad m) => ServerT ReaderAPI (AppT m)
readerServer = rawValue :<|> fromConfig :<|> Tagged (error "raw server") :<|> emptyServer

nt :: AppConfig -> AppT IO x -> Handler x
nt config x = do
  res <- liftIO $ runExceptT $ runReaderT (runApp x) config
  case res of
    Left e       -> throwError e
    Right result -> return result

mainServer :: AppConfig -> Application
mainServer config = serve readerApi api
  where
    api = hoistServer readerApi (nt config) readerServer

我错过的一件事是正确使用 hoistServer。在我创建了从 monad (AppT) 到 Handler 的正确自然转换后，一切都按预期编译并工作。