Слуга ошибка функциональная зависимость с `enter`

Question

Я немного изменил приложение, показанное в рабу учебник, чтобы сделать Reader монады ReaderT, как и

{-# LANGUAGE DataKinds     #-} 
{-# LANGUAGE DeriveGeneric    #-} 
{-# LANGUAGE FlexibleInstances   #-} 
{-# LANGUAGE GeneralizedNewtypeDeriving #-} 
{-# LANGUAGE MultiParamTypeClasses  #-} 
{-# LANGUAGE OverloadedStrings   #-} 
{-# LANGUAGE PolyKinds     #-} 
{-# LANGUAGE ScopedTypeVariables  #-} 
{-# LANGUAGE TupleSections    #-} 
{-# LANGUAGE TypeOperators    #-} 

module Lib 
    (runServer 
    ) where 

import   Control.Monad.Except 
import   Control.Monad.Reader 
import qualified Data.Text    as T 
import   Network.Wai 
import   Servant 

type WebApi 
    = "static" :> Raw 
    :<|> "foo" :> Get '[PlainText] T.Text 

type Foo = String 

server :: ServerT WebApi (ReaderT Foo (ExceptT ServantErr IO)) 
server = static :<|> foo 
    where 
    static :: Application 
    static = undefined 

    -- Handler T.Text 
    foo :: ReaderT Foo (ExceptT ServantErr IO) T.Text 
    foo = undefined 

webAPI :: Proxy WebApi 
webAPI = Proxy 

readerToHandler :: Foo -> ReaderT Foo (ExceptT ServantErr IO) :~> ExceptT ServantErr IO 
readerToHandler t = Nat (\x -> runReaderT x t) 

-- readerServer :: ServerT WebApi (ExceptT ServantErr IO) 
-- readerServer = enter (readerToHandler "foobarbaz") server 

-- serve' :: Application 
-- serve' = serve webAPI server 

runServer :: IO() 
runServer = return() 

Беда в том, что я не могу позволить readerServer функцию, тип проверка не выполняется с этой непостижимой ошибкой

src/Lib.hs:45:16: error: 
    • Couldn't match type ‘IO’ with ‘ExceptT ServantErr IO’ 
     arising from a functional dependency between: 
      constraint ‘Servant.Utils.Enter.Enter 
         (IO ResponseReceived) 
         (ReaderT Foo (ExceptT ServantErr IO) :~> ExceptT ServantErr IO) 
         (IO ResponseReceived)’ 
      arising from a use of ‘enter’ 
      instance ‘Servant.Utils.Enter.Enter (m a) (m :~> n) (n a)’ 
      at <no location info> 
    • In the expression: enter (readerToHandler "foobarbaz") server 
     In an equation for ‘readerServer’: 
      readerServer = enter (readerToHandler "foobarbaz") server 
Failed, modules loaded: none. 

Любые идеи, что пойдет не так?

Answer 1

Проблема заключается в наличии конечной точки Raw, которая плохо взаимодействует с enter. Это known annoyance в Слуге.

Модельный ряд Enter определяет, какие наборы обработчиков могут быть преобразованы и с какими преобразованиями. Он имеет три варианта:

• Enter (m a) ((:~>) m n) (n a) Простейший случай. Если у вас есть монадическое действие и естественное преобразование, которое переносит его в другую монаду, вы можете применить преобразование.

• Enter b arg ret => Enter (a -> b) arg (a -> ret). Если у вас есть обработчик, который принимает параметр, и вы знаете, как преобразовать окончательное монадическое действие обработчика, вы можете преобразовать обработчик, используя то же преобразование arg.

• (Enter typ1 arg1 ret1, Enter typ2 arg2 ret2, (~) * arg1 arg2) => Enter ((:<|>) typ1 typ2) arg1 ((:<|>) ret1 ret2) Если у Вас есть состав :<|> обработчиков и каждый обработчик может быть преобразован в индивидуальном порядке с использованием же естественного преобразования arg1, то можно преобразовать композицию с arg1, а также.

Это последнее условие не выполняется в вашем примере, потому что обработчик Raw имеет тип Application, который Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived, в то время как другой обработчик является ReaderT Foo (ExceptT ServantErr IO) действием. Типы не совпадают, поэтому в композиции нет экземпляра Enter.

---

Существует workaround: вызов enter на пользовательских обработчиков, и только потом создавать их с помощью Application обработчика.

type WebApi 
    = "static" :> Raw 
    :<|> FooEndpoint 

type FooEndpoint = "foo" :> Get '[PlainText] T.Text 

readerServer :: ServerT WebApi (ExceptT ServantErr IO) 
readerServer = static :<|> enter (readerToHandler "foobarbaz") foo 
    where 
    static :: Application 
    static = undefined 
    foo :: ReaderT Foo (ExceptT ServantErr IO) T.Text 
    foo = undefined