3

请向下滚动以阅读对此问题的重要编辑

原始（冗长）问题

我的网络应用程序的代码是用类型类约束的 monad 编写的，看起来像这样：

fetchOrderById :: (HasDatabase m) => Args -> m Result

sendConfirmationMail :: (HasSmtp m) => Args -> m EmailId

每个模块都有自己的server块，如下所示：

data Routes route = Routes
  { rFetchOrder :: route :- CustomAuth :> "orders" :> Capture "OrderId" OrderId :> Get '[JSON] Order
  , rDeleteOrder :: route :- CustomAuth :> "deleteOrder" :> Capture "OrderId" OrderId :> Delete '[JSON] ()
  }

--
-- NOTE: This type-signature WILL NOT compile...
--
server :: Routes (AsServerT m)
server = Routes
  { rFetchOrder = \userId orderId -> runForUser fetchOrderPerms userId $ fetchOrderById orderId
  , rDeleteOrder = \userId orderId -> runForUser deleteOrderPerms userId $ deleteOrderById orderId
  }

fetchOrderPerms :: Proxy '[ 'PermissionFetchOrder]
fetchOrderPerms = Proxy

deleteOrderPerms :: Proxy '[ 'PermissionDeleteOrder]
deleteOrderPerms = Proxy

现在，该runForUser函数是“一对”单子的来源。我想要runForUser以下类型-sig，它将“内部单子”n转换为外部单子，m而不会使它们中的任何一个具体化：

runForUser :: UserId -> n a -> m a

这种“类型类魔法”需要尽可能长时间地不提交具体的 monad，希望这将允许我编写测试。

当最终为生产应用程序连接时，以下是runForUid将发生变化的内容：

AppM '[PermissionFetchOrder] a -> ServantM a

AppM '[PermissionDeleteOrder] a -> ServantM a

-- and so on...

当进行测试时：

TestM '[PermissionFetchOrder] a -> TestServantM a

TestM '[PermissionDeleteOrder] a -> TestServantM a

-- and so on...

我正在努力为该runForUid函数编写一个类型类。我尝试了各种技术，我得到的最接近的是以下技术：

-- 
-- This compiles...
--
class (HasDatabase (InnerMonad m), HasSmtp (InnerMonad m)) => RunForUser m where
  type InnerMonad m :: * -> *

  runForUser :: Proxy (p :: [Permission]) ->  UserId -> (InnerMonad m) a -> m a


--
-- Even this compiles...
--
server :: (RunForUser m) => Routes (ServerT m)
server = Route
  { rFetchOrder = \uid orderId -> runForUser fetchOrderPerms userId $ fetchOrderById orderId
  , rDeleteOrder = ...
  }

-- 
-- And this is where it gets stuck, because the compiler 
-- doesn't know how to deal with `perms` as it is not in 
-- scope
--
instance (HasDatabase (AppM perms), HasSmtp (AppM perms)) => RunForUser ServantM where
  type InnerMonad ServantM = AppM (perms :: [Permission])

  runForUser permProxy userId action = ...

如果我上面提出的解决方案是在正确的轨道上，那么我的问题是 - 我如何告诉编译器不要担心perms？这是实施的一项工作runForUser。我可以RankNTypes以任何方式使用并粘在forall perms某个地方并让它工作吗？

另一方面，如果上面给出的方法完全是垃圾，有什么更好的方法来完成这项工作？

编辑

我可能已经找到了一个可接受的解决方案，但我仍在寻找一种更好的方法来避免与类型相关的样板。

{-# LANGUAGE DataKinds, RankNTypes, PartialSignature, ScopedTypeVariables -#}

type HasApp m = (HasDatabase m, HasSmtp m)

class HasServant ...

class (HasApp m, HasServant n) => RunForUser m n where
  runForUser :: Proxy (perms :: [Permission]) -> UserId -> m a -> n a

server :: forall m n . (RunForUser m n, HasApp m) => Routes (AsServerT n)
server = Routes
  { rFetchOrder = \userId orderId -> 
      runForUser fetchOrderPerms userId 
        --
        -- NOTE: Had to manually annotate the type `m a` and had
        -- to use PartialTypeSignatures to avoid having to specify
        -- the type `a` again.
        --
        (fetchOrderById orderId :: m _)
  , ...
  }
4

1 回答 1

0

尽管我的整个代码库尚未编译，但我可能有一个可能的答案RankNTypes：

type HasApp m = (HasDatabase m, HasSmtp m)

type UserRunner m n = (forall perms a . Proxy (perms :: [Permission]) -> UserId -> (HasApp (m perms) => m perms a) -> n a)

server :: UserRunner m n -> Routes (AsServerT n)
server runForUid = Routes
  { rFetchOrder = \uid orderId -> runForUid fetchOrderPerms uid $ fetchOrderById orderId
  , rDeleteOrder = \uid orderId -> runForUid deleteOrderPerms uid $ deleteOrderById orderId
  }
于 2019-07-09T05:01:35.823 回答