在 Haskell 中创建通用类型类

Creating Generic Typeclasses in Haskell

作为让我的大脑围绕 Haskell 类型和类型classes 展开思考的练习,我正在尝试实现一个简单的 DDD/CQRS 风格的解决方案。我在 Lev Gorodinski's F# Simple CQRS 实施后直接对其建模。

我实现了一个非常简单的 Vehicle 聚合,它或多或少是 Lev 的 InventoryItem 聚合

的直接端口
module Vehicle where

data State = State { isActive :: Bool } deriving (Show)
zero = State { isActive = True }

type Mileage = Int 

data Command = 
    Create String Mileage
    | UpdateMileage Mileage
    | Deactivate
    deriving (Show)    

data Event =
    Created String
    | MileageUpdated Mileage 
    | Deactivated
    deriving (Show)

-- Define transitions from a command to one or more events
execute :: State -> Command -> [Event] 
execute state (Create name mileage)   = [Created name, MileageUpdated mileage]
execute state (UpdateMileage mileage) = [MileageUpdated mileage]
execute state Deactivate              = [Deactivated]    

-- Apply an event against the current state to get the new state
apply :: State -> Event -> State
apply state (Created _)        = state
apply state (MileageUpdated _) = state
apply state Deactivated        = state { isActive = False }

我想弄清楚的部分是如何为域聚合创建更高级别的抽象,因为所有聚合都将由相同的组件组成。在 Lev 的示例中,他定义了一个类型 Aggregate<'TState, 'TCommand, 'TEvent>,这允许他定义一个通用的命令处理程序,该处理程序将对域聚合的任何实例起作用。在 Haskell 中,这感觉像是我应该使用 Typeclasses 的东西。当然,因为我不知道我在做什么,所以这可能是对它们用途的完全误解。

我的想法是 Aggregate 类型 class 会定义 executeapply 命令的接口,以及某种程度上需要关联类型的类型来表示它的状态、命令和事件。从那里我可以定义一些通用的命令处理程序,这些处理程序能够针对聚合的任何实例执行命令。例如

class Aggregate a where =
    execute :: state -> command -> [event]
    apply   :: state -> event   -> state

其中 statecommandevent 是表示给定 Aggregate 实例的状态、命令和事件的类型变量。这当然行不通。

我正在尝试做的是对 Typeclasses 的适当使用吗?如果是这样,我应该如何定义 class 以使 Aggregate 的实例必须具有相应的状态、命令和事件类型?

如果这是错误的方法,我应该如何定义 Aggregate 以创建更高级别的抽象?

更新

按照@jberryman 的建议,我使用 MPTC 来定义我的聚合,这使我能够创建我正在寻找的通用命令处理程序:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}

module Aggregate where

class Aggregate state command event
    | state -> command event, command -> state event, event -> state command where
        execute :: state -> command -> [event]
        apply   :: state -> event   -> state
        zero    :: state

makeHandler (load, commit) = 
    (\ (id, expectedVersion) command -> 
        do events <- load id
           let state = foldl apply zero events
           let newEvents = execute state command
           commit (id, expectedVersion) newEvents)

这又导致我的 Vehicle 模块中出现以下实例声明

instance Aggregate State Command Event where
    execute = Vehicle.execute
    apply   = Vehicle.apply
    zero    = Vehicle.zero

然后是一个示例脚本将它们结合在一起:

import Aggregate
import Vehicle

-- Mock out IO to a domain repository (EventStore)
load :: Int -> IO [Event]
load id = do return [Created "Honda", MileageUpdated 15000]
commit (id, expectedVersion) events = putStrLn (show events)

-- Create the handler provide a command to it
handler = makeHandler (load, commit)
handler (1,1) Deactivate

如果 statecommandevent 是一个三元组,它们对于特定实例都是唯一的,您可以将 MultiParameterTypeClassesFunctionalDependencies 一起使用,例如

class Aggregate state command event | state -> command event, command -> state event, event -> state command  where
    execute :: state -> command -> [event]
    apply   :: state -> event   -> state

| 之后的 fundeps 读作:"where command and event are uniquely determined by state, and state and event are uniquely determined by command, and..." 等。如果我们可以推断出实例头中的任何一种类型,则可以解析实例。您可以对类型族执行相同的操作。

但是在定义类型之前你应该问自己三个问题 class:

  • 我打算在此 class 中编写有用的多态代码吗?
  • 我是否期望用户定义他们自己的实例我没有想到?
  • 它有什么规律吗?

如果所有这些的答案是否定的,那么您可能不应该定义类型 class。很难回答这里是否是这种情况。

但它可能是例如你真正想要的是:

data Aggregate state command where 
   Aggregate :: (state -> command -> [event]) -> (state -> event   -> state) -> Aggregate state command

这是隐藏了 event 的 GADT。

我不熟悉 Lev Gorodinski 的 F# 示例,因此不能保证指向正确的方向,但我看了一下,它看起来像是它的一种用法 Aggregate类型是 create handlers。如果我们忽略那些函数隐含的所有不纯操作,核心操作似乎是:

  • 折叠事件得到当前状态
  • 针对该状态执行命令

因此,受@jberryman 的回答启发,您可以这样定义一个类型类:

class Aggregate state command event | event -> state command where
  eventsToState :: [event] -> state
  execute :: state -> command -> [event]

为了编译,您需要 FunctionalDependencies 语言扩展。

您现在可以基于该类型类将处理函数的核心编写为通用函数:

handle :: Aggregate state command event => command -> [event] -> [event]
handle command = flip execute command . eventsToState

您现在可以为 OP 中定义的类型定义 Aggregate 的实例:

instance Aggregate State Command Event where
  eventsToState = foldl folder zero
    where
      folder state (Created _)        = state
      folder state (MileageUpdated _) = state
      folder state Deactivated        = state { isActive = False }
  execute _ (Create name mileage)   = [Created name, MileageUpdated mileage]
  execute _ (UpdateMileage mileage) = [MileageUpdated mileage]
  execute _ Deactivate              = [Deactivated]

在 GHCI 中试用:

*Vehicle> handle (Create "BMW 520i" 250000) [] :: [Event]
[Created "BMW 520i",MileageUpdated 250000]
*Vehicle> handle (UpdateMileage 256000) it
[MileageUpdated 256000]
*Vehicle> handle Deactivate it
[Deactivated]

我没有进一步查看 Lev Gorodinski 的 F# 示例,所以我不确定这是否足够,但我希望这是一个开始。