Haskell 为数据处理管道键入安全插件

我正在编写一个用于编写Discord机器人的Haskell库，我非常希望能够让我的库的用户编写类型安全的插件

Discord向我发送的消息大致如下：

data EventType
    = FooEvent
    | BarEvent
    deriving (Eq, Show)

data Payload
    = Payload
    { eventType :: EventType
    , payload :: Maybe Value
    }

eventType

参数唯一地确定了在

payload

参数中发送的JSON对象，对于某些

eventType

s，也可能根本没有有效负载

我感兴趣的是让库的用户在类型级别声明他们希望处理哪种类型的事件，然后使用类型系统要求具有适当类型的函数。然后我希望能够获取所有这些插件，无论其类型如何，并将它们视为同质实体，基本上只获取我当前正在处理的任何消息，在系统中所有插件的列表中运行它，每个插件将尝试将

有效负载

JSON值转换为适当的类型，如果转换成功，则运行其代码

例如，我们可以使用以下有效负载类型：

data FooPayload = FooPayload {foo :: String}
    deriving (Read, Eq, Show,  Generic)
instance ToJSON FooPayload
instance FromJSON FooPayload

data BarPayload = BarPayload {bar :: String}
    deriving (Read, Eq, Show,  Generic)
instance ToJSON BarPayload
instance FromJSON BarPayload

到目前为止，我所做的是创建一个具有关联类型的类型类：

class FromJSON (PayloadType ev) => Convertible (ev :: EventType) where
    type PayloadType ev :: *
    convert :: Value -> Maybe (PayloadType ev)
    convert = parseMaybe parseJSON

    -- run :: Proxy (PayloadType ev) -> Plugin ev s -> Value -> IO ()
    run :: Plugin ev s -> Value -> IO ()
    run p v = undefined
        -- case convert v of
        --     Just v' -> runPlugin p v' -- doesn't typecheck because of non-injectivity of type families
        --     Nothing -> return ()

以及附带的例子

instance Convertible 'FooEvent where
    type PayloadType 'FooEvent = FooPayload

instance Convertible 'BarEvent where
    type PayloadType 'BarEvent = BarPayload

以及以下类型：

data Plugin (ev :: EventType) s
    = Convertible ev => Plugin
    { initializePlugin :: IO s
    , runPlugin :: PayloadType ev -> IO ()
    }


newtype RunnablePlugin = RunnablePlugin (Hide Plugin)
data Hide f = forall (ev :: EventType) s. Convertible ev => Hide (f ev s)

然后，我可以定义几个插件，并对它们进行相同的处理：

fooPlugin :: Plugin 'FooEvent ()
fooPlugin =
    Plugin
    { initializePlugin = return ()
    , runPlugin = \_ -> putStrLn "This is a foo plugin"
    }

barPlugin :: Plugin 'BarEvent ()
barPlugin =
    Plugin
    { initializePlugin = return ()
    , runPlugin = \_ -> putStrLn "This is a bar plugin"
    }

plugins :: [RunnablePlugin]
plugins =
    [ RunnablePlugin $ Hide fooPlugin
    , RunnablePlugin $ Hide barPlugin
    ]

理想情况下，我可以做到以下几点

runPlugins :: Value -> [RunnablePlugin] -> IO ()
runPlugins val plugs = do
    forM_ plugs $ \(RunnablePlugin (Hide p)) -> do
        run p val
        return ()

因此，理想情况下，运行

runPlugins（toJSON（foodpayload“foo”））插件将打印
这是一个foo插件

除了type类中的
run
的注释定义之外，所有类型都会进行检查

我想我基本上理解了问题所在——我删除类型信息是为了把事情处理得一模一样，而用我所拥有的来恢复类型信息是不可能的。无论如何，这是我的直觉，但我对这种“类型争论”不太适应

我试图用我们在GHC/Haskell中拥有的东西来完成的是可能的，还是我需要依赖类型来完成的

可以找到完整的代码。
下面是我如何做到这一点的。它与您现有的代码有很大的不同，而且这不是唯一的方法。我只是认为这样做将使未来的代码更容易编写

data EventType = FooEvent | BarEvent
data Payload :: EventType -> * where
  FooPayload :: { foo :: String } -> Payload FooEvent
  BarPayload :: { bar :: String } -> Payload BarEvent

我们为
EventType
提供了单例。如果您不知道这些是什么，那么模拟依赖类型本质上就是一种黑客行为：

-- use a library like singletons to avoid this tedium
-- singletons will call this Sing
data SEventType :: EventType -> * where
  SFooEvent :: SEventType FooEvent
  SBarEvent :: SEventType BarEvent
-- these classes sort of "factor out" the need for classes later
-- the class will be named SingI and its method sing under singletons
class KEventType (ev :: EventType) where kEventType :: SEventType ev
instance KEventType FooEvent where kEventType = SFooEvent
instance KEventType BarEvent where kEventType = SBarEvent
-- singletons generates these, too
-- SomeSEventType would be called SomeSing EventType; it's isomorphic to EventType
data SomeSEventType = forall ev. SomeSEventType (SEventType ev)
toSing :: EventType -> SomeSEventType
toSing = _obvious
fromSing :: SomeSEventType -> EventType
fromSing = _obvious

-- A Payload ev contains enough information to determine ev
payloadEventType :: Payload ev -> SEventType ev
payloadEventType FooPayload {} = SFooEvent
payloadEventType BarPayload {} = SBarEvent

对于任何
EventType
ev
，我们都有一个相应的
值->解析器（有效负载ev）

我们还可以从JSON制作一个
：

-- example of previous comment
-- this instance can be just the one instance instead of one per EventType
-- parseEventPayload will get warnings if it doesn't cover everything
-- and other good things
instance KEventType ev => FromJSON (Payload ev) where
  parseJSON = parseEventPayload kEventType

现在，我们定义Discord发送给您的消息类型（类型和负载）：

data Message = forall ev. Message (Payload ev)
-- in singletons
-- newtype Message = Message (Sigma EventType (TyCon Payload))

这是一个相关对：
消息包含“一个
事件类型
ev
和一个
有效负载ev
。
EventType
不需要直接的运行时表示，因为GADTs的魔力意味着
有效负载ev
足以确定
ev
。（
singleton
的
Sigma
将
ev
表示为一个
seventypev
，因为它不知道更好，但我正在手动编写，并且确实知道得更清楚。）大概，您会得到作为JSON的
消息
s：

instance FromJSON Message where
  parseJSON v = f . toSing =<< parseEventType v
    where parseEventType :: Value -> Parser EventType
          parseEventType = _
          -- find the payload inside the bigger value without parsing
          payload :: Value -> Parser Value
          payload = _
          f :: SomeSEventType -> Parser Message
          f (SomeSEventType ev) = Message <$> (parseEventPayload ev =<< payload v)

但是
runnablelplugin
必须记住事件类型：

data RunnablePlugin = forall ev s. RunnablePlugin (SEventType ev) (Plugin ev s)

您可以隐式地接受第一个参数

runnablePlugin :: KEventType ev =>
                  Plugin ev s -> RunnablePlugin
runnablePlugin = RunnablePlugin kEventType

现在，您的
运行
似乎不太正确。据推测，Discord会向您发送一些带有事件类型和负载的JSON。您将其反序列化为一条
消息
（该消息反序列化类型和负载）。您不应该在这一点之后传递
值
s，因为这样做效率很低。
run
有四种可能的变体。您可以获取键入的
有效负载
或存在的
消息
，也可以获取
插件
或
RunnablePlugin
runPlugin
填补了“所有已知类型的利基”，因此此
run
将是所有存在的。首先，我们需要平等对待单身人士：

-- singletons generates this under the name (%~) if EventType derives Eq
sEventTypeEq :: SEventType l -> SEventType r ->
                Maybe (l :~: r)
sEventTypeEq SFooEvent SFooEvent = Just Refl
sEventTypeEq SBarEvent SBarEvent = Just Refl
sEventTypeEq _ _ = Nothing

然后

runPlugins
是最简单的位

runPlugins :: Message -> [RunnablePlugin] -> IO ()
runPlugins = traverse_ . run

TypeApplications
可以避免一些注入性错误。也许试试看？或者，您可以只使用数据族，因为
FooPayload
与
PayloadType FooEvent
没有太大区别（您可能需要缩短名称）。谢谢您的详细回答！实际上，我成功地设计出了一些适用于数据族的东西，但这并不是最优的，因为它需要我携带一个
值
，并将它们的解析延迟到插件真正需要它时，这使得在数据类型定义/解析逻辑中很难找到bug。我尝试了单例方法，除了我使用了库，但我承认我在这里有点不知所措，我遇到了你可以在我的代码中看到的问题：（在另一条评论中继续）你可以看到，我的代码显示了与我所问的有点不同的情况，因为消息中实际上有两个参数确定有效负载。对于某些操作码，没有事件参数，然后操作码确定有效负载。对于其他操作码，存在事件参数，用于确定有效负载。我不确定我的问题是否是因为这个附加参数。我将把你的答案标记为解决方案，因为它本质上正是我所寻找的。@identity你的
RunnablePlugin
既有
SingI
s又有
Sing
s。这些将是重复的。通常，您希望坚持对实际代码使用
Sing
，如果需要，可以使用隐式
SingI
版本将其包装
SomeMessage
根本不需要
SingI
s，因为
Payload
已经包含该信息。如果你真的需要它们，有一个函数
-- singletons generates this under the name (%~) if EventType derives Eq
sEventTypeEq :: SEventType l -> SEventType r ->
                Maybe (l :~: r)
sEventTypeEq SFooEvent SFooEvent = Just Refl
sEventTypeEq SBarEvent SBarEvent = Just Refl
sEventTypeEq _ _ = Nothing

run :: Message -> RunnablePlugin -> IO ()
run (Message py) (RunnablePlugin pge pg) = case sEventTypeEq (payloadEventType py) pge of
  Just Refl -> runPlugin pg py
  Nothing -> return ()

runPlugins :: Message -> [RunnablePlugin] -> IO ()
runPlugins = traverse_ . run