Использование маршрутов Servant.Generic с ReaderT (Pool Connection) IO

Question

Я использовал servant-generic-0.1.0.3 а также servant-server-0.13.0.1 сделать следующее:

data Site route = Site
  { page :: route :-
      "page" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] [Int]
  , home :: route :-
      Raw
  } deriving (Generic)

type API = ToServant (Site AsApi)

siteServer :: Pool Connection -> Site AsServer
siteServer pool = Site
  { page = \x y ->
      liftIO $ withResource pool $ \conn -> someDbFunction conn x y
  , home = serveDirectoryWebApp "static"
  }

api :: Proxy API
api = Proxy

app :: Pool Connection -> Application
app pool = serve api (toServant $ siteServer pool)

Это работало нормально, затем я попытался использовать ReaderT чтобы избежать прохождения Pool Connection в siteServerвот я и добавил AppM и заменил siteServer как это:

type AppM = ReaderT (Pool Connection) IO

siteServer :: ServerT API AppM
siteServer = Site
  { page = do
      pool <- ask
      \x y ->
        liftIO $ withResource pool $ \conn -> someDbFunction conn x y
  , home = serveDirectoryWebApp "static"
  }

но я получил кучу ошибок, когда я пытался скомпилировать его.

Я выполнил те же действия, что и в поваренной книге для слуг, но не смог выполнить эту работу с общими маршрутами, хотя это работает при использовании обычных маршрутов.

Я что-то упустил, что могло бы сделать эту работу?

Answer 1

По крайней мере для маршрутов в стиле записи, поддерживаемых servant-* >= 0.14 (см. Здесь), если вы хотите работать с другой монадой, чем Handler, вы хотите посмотреть на AsServerT а также genericServerT,

Применительно к вашему примеру это означает siteServer должно быть определено следующим образом (не проверено типом, но должно быть очень близко к правильному).

siteServer :: Site (AsServerT AppM)
siteServer = Site
  { page = ... something in AppM ...
  , home = ... something in AppM ...
  }

-- turning that into a usual chain of :<|>-separated handlers
oldStyleServer :: ServerT API AppM
oldStyleServer = genericServerT siteServer

-- bringing it all back in Handler
oldStyleServerInHandler :: Pool Connection -> Server API -- same as ServerT API Handler
oldStyleServerInHandler conns = hoistServer (Proxy @API) appToHandler oldStyleServer
  where appToHandler = liftIO . flip runReaderT conns
        -- or something along those lines

-- serving it
app :: Pool Connection -> Application
app conns = serve (Proxy @API) (oldStyleServerInHandler conns)

Изменить: так как вы используете servant-* < 0.14 с универсальным слугой, вы должны заменить genericServerT с toServant,