Haskell中如何缩小world-peace库的OpenUnion联合类型？

要实现将OpenUnion as窄化为OpenUnion bs（要求bs ⊂ as）的函数，我们可以利用world-peace库的OpenUnion类型特性，结合递归类型匹配来完成。核心思路是：尝试匹配原联合类型中的值是否属于目标窄化联合类型的成员，匹配成功则重新打包，否则返回Nothing。

实现代码 #

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

import WorldPeace (OpenUnion, Contains, openUnionPrism)
import Control.Lens (preview, review)
import Data.Maybe (listToMaybe)

-- 辅助类型类：递归匹配目标联合类型的成员
class ShrinkUnion bs as where
  shrinkUnion :: OpenUnion as -> Maybe (OpenUnion bs)

-- 空目标联合类型：无匹配可能，直接返回Nothing
instance ShrinkUnion '[] as where
  shrinkUnion _ = Nothing

-- 递归处理目标联合类型的第一个成员
instance (Contains '[b] as, ShrinkUnion bs as) => ShrinkUnion (b ': bs) as where
  shrinkUnion u = 
    case preview (openUnionPrism @b) u of
      -- 匹配到目标类型，重新打包为窄化联合类型
      Just x -> Just (review openUnionPrism x)
      -- 未匹配则递归处理剩余类型
      Nothing -> shrinkUnion @bs u

-- 主函数：约束目标联合类型是原类型的子集，调用辅助类完成匹配
unionShrink :: forall bs as. (Contains bs as, ShrinkUnion bs as) => OpenUnion as -> Maybe (OpenUnion bs)
unionShrink = shrinkUnion @bs

代码说明 #

1. ShrinkUnion类型类：负责递归遍历目标联合类型bs的成员，尝试与原联合类型OpenUnion as中的值匹配。
2. 空列表实例：当目标联合类型为空时，不可能有匹配的值，直接返回Nothing。
3. 递归实例：先尝试匹配bs的第一个类型b，通过preview openUnionPrism检查原联合类型是否包含该类型的值；匹配成功则用review打包为OpenUnion bs，失败则继续递归匹配剩余类型。
4. 主函数约束：Contains bs as确保bs是as的子集，保证所有目标类型都能在原联合类型中被合法匹配。

使用示例 #

-- 定义原联合类型和窄化目标类型
type FullUnion = '[Int, String, Bool]
type NarrowUnion = '[Int, String]

-- 创建原联合类型的实例
intUnion :: OpenUnion FullUnion
intUnion = review openUnionPrism (42 :: Int)

boolUnion :: OpenUnion FullUnion
boolUnion = review openUnionPrism (True :: Bool)

-- 测试窄化转换
test1 :: Maybe (OpenUnion NarrowUnion)
test1 = unionShrink intUnion -- 返回 Just (包含42的NarrowUnion实例)

test2 :: Maybe (OpenUnion NarrowUnion)
test2 = unionShrink boolUnion -- 返回 Nothing（Bool不在NarrowUnion中）

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