Haskell游戏开发：仅扩展自身知晓状态时如何实现可扩展状态

针对你希望编译时指定启用扩展、自动整合状态与透镜、减少冗余代码的需求，可以结合GHC的类型级特性（DataKinds、TypeFamilies）与TemplateHaskell实现一套自动化的扩展系统，完全避免手动定义状态字段和传递透镜的繁琐工作。

核心实现代码 #

1. 扩展基础框架模块 #

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}

import Control.Lens (Lens', over, makeLenses)
import Language.Haskell.TH

-- 用空数据类型标记每个扩展的唯一标识
data DogExt  -- 狗狗扩展标识
data CatExt  -- 猫咪扩展标识

-- 关联类型：为每个扩展绑定对应的状态类型
type family ExtState (ext :: *) :: * where
  ExtState DogExt = Int       -- 狗狗的状态是整数（比如计数）
  ExtState CatExt = String    -- 猫咪的状态是字符串（比如名字）

-- 类型类：自动获取扩展在全局状态中的透镜
class HasExtension (ext :: *) s | s -> ext where
  extLens :: Lens' s (ExtState ext)

-- TemplateHaskell自动生成全局GameState、透镜与类型类实例
mkGameState :: [Name] -> Q [Dec]
mkGameState exts = do
  -- 为每个扩展生成对应的状态字段名（如dogExtState）
  fieldNames <- mapM (\ext -> newName (nameBase ext ++ "State")) exts
  
  -- 生成GameState数据定义：每个字段对应一个扩展的状态
  let gameStateCon = RecC (mkName "GameState")
        [ (fieldName, NotStrict, ConT ''ExtState `AppT` ConT ext)
        | (ext, fieldName) <- zip exts fieldNames
        ]
      gameStateDec = DataD [] (mkName "GameState") [] Nothing [gameStateCon] []
  
  -- 自动生成所有字段的透镜
  lensDecs <- makeLenses (mkName "GameState")
  
  -- 自动生成HasExtension实例：每个扩展对应自己的透镜
  instanceDecs <- mapM (\(ext, fieldName) -> do
    let lensName = mkName (nameBase fieldName ++ "_")
        instanceHead = AppT (AppT (ConT ''HasExtension) (ConT ext)) (ConT (mkName "GameState"))
        body = FunD 'extLens [Clause [] (NormalB (VarE lensName)) []]
    return $ InstanceD Nothing [] instanceHead [body]
    ) (zip exts fieldNames)
  
  -- 自动生成初始状态（可选，需要配合InitExtension类型类）
  initDecs <- genInitialState exts fieldNames
  
  return $ gameStateDec : lensDecs ++ instanceDecs ++ initDecs

-- 可选：自动生成初始状态的辅助函数
genInitialState :: [Name] -> [Name] -> Q [Dec]
genInitialState exts fieldNames = do
  let fields = map (\(ext, fieldName) -> (fieldName, VarE 'initExt `AppTypeE` ConT ext)) (zip exts fieldNames)
      recordExp = RecConE (mkName "GameState") fields
      sig = SigD (mkName "initialState") (ConT (mkName "GameState"))
      def = ValD (VarP (mkName "initialState")) (NormalB recordExp) []
  return $ sig : [def]

-- 类型类：定义扩展的初始状态
class InitExtension (ext :: *) where
  initExt :: ExtState ext

2. 业务模块：启用扩展并编写效果函数 #

-- 导入基础框架模块
import GameExtFramework

-- 为扩展实现初始状态
instance InitExtension DogExt where
  initExt = 0  -- 狗狗初始计数为0

instance InitExtension CatExt where
  initExt = "Kitty"  -- 猫咪初始名字为Kitty

-- 编译时指定要启用的扩展列表：自动生成GameState、透镜等
$(mkGameState [''DogExt, ''CatExt])

-- 编写扩展的效果函数：无需手动传递透镜，自动通过HasExtension获取
doDog :: HasExtension DogExt s => s -> s
doDog = over extLens (+1)  -- 狗狗计数+1

doCat :: HasExtension CatExt s => s -> s
doCat = over extLens (++ " meow")  -- 猫咪名字追加"meow"

-- 使用示例
main :: IO ()
main = do
  let newState = doDog $ doCat initialState
  print newState
  -- 输出：GameState { _dogExtState = 1, _catExtState = "Kitty meow" }

方案优势 #

1. 编译时扩展管理：只需在mkGameState中列出要启用的扩展，所有状态整合、透镜生成、类型类实例都会自动完成
2. 无冗余代码：无需手动定义GameState字段、传递透镜，效果函数只需要关注自身逻辑
3. 类型安全：如果效果函数依赖的扩展未启用，编译时直接报错，避免运行时问题
4. 扩展性强：新增扩展只需定义标识类型、状态类型和初始状态，无需修改全局状态结构

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