haskell - 类型脚手架/交换组合

Question

我有 3 种类型:Task(一个工作单元)、Estimate(一个时间段)和 User。

在我的应用程序中，我想“装饰”我的 Task 以制作 EstimedTask(可以求和)，AssignedTask(待排序)和 AssignedEstimatedTask(我可以在其上应用甘特算法)

我的第一个尝试是用元组实现它们:

EstimatedTask :: (Task, Estimate)
AssignedTask :: (Task, User)
AssignedEstimatedTask :: (Task, Estimate, User)

但是如果我想构造一个AET，我必须定义 3 个构造函数

T -> E -> U -> AET
(T, E) -> U -> AET
(T, U) -> E -> AET

我打算再装饰一下，恐怕构造器的数量会爆炸。

有没有聪明的方法来做到这一点？特别是，是否有一种使子构造函数可交换的首选方法(例如 assign .estimate $task == estimate .assign $task ？

Answer 1

定义 data Controlled::Type -> Bool -> Type 使得 Controlled t False 是单例类型(如 ()，无信息)和 Controlled t True 是 t 的副本:

data Controlled :: Type -> Bool -> Type where
    Exists :: a -> Controlled a True
    NonExist :: Controlled a False

然后用 Controlled 插槽定义一个“完整”类型来表示您可以拥有的一切:

data AssignedEstimatedTask' :: Bool -> Bool -> Type where
    AssignedEstimatedTask ::
        { getTask :: Task
        , taskUser :: Controlled User a
        , taskEstimate :: Controlled Estimate b } ->
        AssignedEstimatedTask' a b

填写一堆同义词:

-- naming the types is exponential!
type JustTask = AssignedEstimatedTask' False False
type AssignedTask = AssignedEstimatedTask' True False
type EstimatedTask = AssignedEstimatedTask' False True
type AssignedEstimatedTask = AssignedEstimatedTask' True True

justTask :: Task -> JustTask
justTask t = AssignedEstimatedTask t NonExist NonExist

现在您可以使用在编译时跟踪的记录更新来向任务添加内容:

jTask :: JustTask
aTask :: AssignedTask
eTask :: EstimatedTask
aeTask, eaTask :: AssignedEstimatedTask
-- ofc, all of ^ could have been inferred
jTask = justTask someTask
aTask = jTask { taskUser = Exists someUser }
eTask = jTask { taskEstimate = Exists someEstimate }
aeTask = aTask { taskEstimate = Exists someEstimate }
eaTask = eTask { taskUser = Exists someUser }
-- aeTask == eaTask

Working example

如果你真的想将记录更新提取为函数，它们看起来像这样

assignTask :: User -> AssignedEstimatedTask' a e -> AssignedEstimatedTask' True e
assignTask u t = t { taskUser = Exists u }
estimateTask :: Estimate -> AssignedEstimatedTask' a e -> AssignedEstimatedTask' a True
estimateTask e t = t { taskEstimate = Exists e }