如何在Haskell中用类型类实现灵活的有限状态机？

问题背景 #

我尝试构建一个简单的有限状态机（FSM），计划用类型类描述每个有限状态：

class FS st where
   fsUpdate :: st -> StatefulEntity -> StateMonad st
   fsStep :: st -> StatefulEntity -> StateMonad ()

这样就能为每个具体状态定义FS实例：

data StateA = StateA Param1 Param2
instance FS StateA where 
   fsUpdate ... = do ... 

我的目标是为StatefulEntity定义一个FSM（动态或静态均可），用和类型表示当前状态，和类型的每个构造函数对应一个拥有FS实例的状态：

data StatefulEntity fs = StatefulEntity EntityData ComposedState 

data ComposedState = OneOF <FS instances > 

runFSM :: StatefulEntity -> StateMonad StatefulEntity -- 分发当前状态，调用fsUpdate  

我已经尝试过两种方案，但都存在问题：

• 带单个stateUpdate函数的简单和类型：用data ComposedState = StateA | StateB这类直接和类型，配合模式匹配的单个更新函数，和特定状态耦合太紧密。
• 用存在类型包装FS实例：抽象性看起来可行，但存在类型管理难度高，不借助复杂类型转换的话，没法检查底层具体状态（比如判断是不是StateA）。

可行实现方案 #

方案一：GADT + 类型类约束（兼顾抽象性与可检查性） #

用GADT定义ComposedState，同时携带FS约束，既保留类型类的抽象行为，又能通过模式匹配直接检查具体状态：

{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

-- 基础定义示例（可替换为实际业务逻辑）
type StateMonad = IO
data EntityData = EntityData String deriving Show

class FS st where
   fsUpdate :: st -> StatefulEntity -> StateMonad st
   fsStep :: st -> StatefulEntity -> StateMonad ()

-- GADT组合状态，每个构造函数携带FS约束
data ComposedState where
  WrapState :: FS st => st -> ComposedState

deriving instance Show ComposedState

-- 重新定义StatefulEntity
data StatefulEntity = StatefulEntity EntityData ComposedState

-- 具体状态示例
data StateA = StateA Int String deriving Show
instance FS StateA where
  fsUpdate (StateA n s) (StatefulEntity ed _) = do
    putStrLn $ "Updating StateA: " ++ s ++ ", entity data: " ++ show ed
    return $ StateA (n+1) s
  fsStep (StateA _ s) _ = putStrLn $ "Stepping StateA: " ++ s

data StateB = StateB Bool deriving Show
instance FS StateB where
  fsUpdate (StateB b) (StatefulEntity ed _) = do
    putStrLn $ "Updating StateB: " ++ show b ++ ", entity data: " ++ show ed
    return $ StateB (not b)
  fsStep (StateB b) _ = putStrLn $ "Stepping StateB: " ++ show b

-- 核心runFSM逻辑
runFSM :: StatefulEntity -> StateMonad StatefulEntity
runFSM (StatefulEntity ed (WrapState st)) = do
  fsStep st (StatefulEntity ed (WrapState st))
  newSt <- fsUpdate st (StatefulEntity ed (WrapState st))
  return $ StatefulEntity ed (WrapState newSt)

-- 检查/提取具体状态示例（无需复杂类型转换）
isStateA :: ComposedState -> Bool
isStateA (WrapState (_ :: StateA)) = True
isStateA _ = False

getStateA :: ComposedState -> Maybe StateA
getStateA (WrapState s@(_ :: StateA)) = Just s
getStateA _ = Nothing

方案优势

• 低耦合：新增状态只需定义data类型和FS实例，无需修改ComposedState或runFSM
• 可检查性：通过GADT模式匹配+类型注解，直接判断或提取特定状态
• 抽象性保留：所有状态行为通过FS接口统一定义，符合初始设计思路

方案二：闭包封装（极简动态调度） #

如果不需要静态检查具体状态，仅需动态分发行为，可以用闭包打包状态与对应逻辑，完全规避类型类和复杂扩展：

type StateMonad = IO
data EntityData = EntityData String deriving Show

-- 闭包封装状态行为
data StateBehavior = StateBehavior
  { sbStep :: StatefulEntity -> StateMonad ()
  , sbUpdate :: StatefulEntity -> StateMonad StateBehavior
  , sbIsStateA :: Bool -- 按需添加状态标识字段
  }

data StatefulEntity = StatefulEntity EntityData StateBehavior

-- 构建StateA的行为实例
mkStateA :: Int -> String -> StateBehavior
mkStateA n s = StateBehavior
  { sbStep = \_ -> putStrLn $ "Stepping StateA: " ++ s
  , sbUpdate = \(StatefulEntity ed _) -> do
      putStrLn $ "Updating StateA: " ++ s ++ ", entity data: " ++ show ed
      return $ mkStateA (n+1) s
  , sbIsStateA = True
  }

-- 构建StateB的行为实例
mkStateB :: Bool -> StateBehavior
mkStateB b = StateBehavior
  { sbStep = \_ -> putStrLn $ "Stepping StateB: " ++ show b
  , sbUpdate = \(StatefulEntity ed _) -> do
      putStrLn $ "Updating StateB: " ++ show b ++ ", entity data: " ++ show ed
      return $ mkStateB (not b)
  , sbIsStateA = False
  }

-- 核心runFSM逻辑
runFSM :: StatefulEntity -> StateMonad StatefulEntity
runFSM (StatefulEntity ed sb) = do
  sbStep sb (StatefulEntity ed sb)
  newSb <- sbUpdate sb (StatefulEntity ed sb)
  return $ StatefulEntity ed newSb

方案优势

• 实现极简：无需任何GHC扩展，代码直观
• 完全动态：状态切换逻辑封装在闭包里，灵活度高
• 状态检查简单：通过显式标识字段实现，无类型转换成本

内容的提问来源于stack exchange，提问作者kubivan