如何使用 Haskell/Aeson 中的类型函数解析多态值？
How do I parse polymorphic values using a type function in Haskell/Aeson?
为了提高我对 Haskell 的理解，我已经开始了一个个人项目，允许用户组合许多依赖于多态环境和状态的预定义转换。
核心类型围绕 c 参数化的环境、结果类型 a 参数化的状态、c 参数化的类型类 Base 组织并确定 a 的类型，以及一个类型类 Step，它给出了在 RWS monad 中定义用户可选择的转换的接口，并且在 [=13] 上进行了参数化=] 和 a:
type Plan c a = Control.Monad.RWS.RWS (Env c) Log (State a)
data Env c = Env c (Set Condition)
data State a = State a (Set Constraint)
class Base c b a | b -> a where
execBase :: Env c -> b -> (State a, Log)
class Step c a s where
defineStep :: s -> Plan c a ()
-- ^ Plans get folded into a single plan with >>
execPlan :: (Base c b a) => Env c -> b -> Plan c a () -> (a, Log)
代码库的其余部分主要定义了几种不同的数据类型，用户可以将其插入 Env 的 c 部分，一些数据类型可以作为结果 a，以及存在的大量数据类型，用于保存一个或两个参数，并且是 Base 或 Step 的实例。失败的地方在于我无法弄清楚如何从用户提供的 JSON 文档中解析其中的任何内容。我开始于：
data Request c a = Request (Env c) (WrappedBase c a) [WrappedStep c a]
data WrappedBase c a where
WrapBase :: (Base c b a, Eq b, Show b, Typeable a, Typeable b)
=> b -> WrappedBase c a
data WrappedStep c a where
WrapStep :: (Step c a s, Eq s, Show s, Typeable s)
=> s -> WrappedStep c a
但我不知道如何说服 GHC 让我为 Request c a 创建一个 Data.Aeson.FromJSON 实例。编写数据类型 SomeC 是微不足道的，它是 c 所有可能情况的总和类型，并且几乎同样容易为 SomeC 编写解析器以及函数 :: c -> Data.Aeson.Value -> Data.Aeson.Parser (Env c)，但我如何将其转换为 Env c 的解析器，以便我可以将 c 与 Request 中的其他 c 统一起来？
（我也尝试过将解析器转换为连续传递样式，但一旦完成，我意识到我根本没有解决问题。）
还有更深层次的谜团，我如何让 GHC 在值级别执行类型函数 b -> a，这样我就可以在 Request 中使 a 指示 a通过 b 的 Base 实例，或者 return 给用户的消息，让他们知道他们选择的 b 没有为 c 他们指定的？
感觉我想要的是使用类型相等见证，但使用类型 类 而不是类型类型 :: *，但我搜索了 GHC 的大量扩展，但没有找到可以允许。
如果您能够为 Request c a 编写解析器，那将意味着解析 JSON 的结果在 c 和 a 中是多态的，所以调用者可以获取结果并将其用作 Request Int Double，然后用作 Request String Bool，这两种方法都有意义。这可能不是你想要的。
我在这里猜测您有一个环境类型 Env c、基本类型 b 和步骤类型 s 的集合，每个类型都有一个独立的 FromJSON 可以在不知道任何其他类型的情况下解析它的实例。 （因此，例如，一个特定的基类型 MyBase 可以被解析为一个 MyBase 值，而无需知道它将使用的环境 c 或状态 a 类型。）
显然，一个特定的具体请求只涉及一种环境类型 Env c 和一种基本类型 b。我不太清楚步骤列表是打算全部是相同类型的步骤还是不同类型的异构步骤列表，但我假设是后者。如果是这样，您的解析所需的最终结果将是嵌套的存在请求类型：
data SomeRequest where
SomeRequest :: (Base c b a) => Env c -> b -> [SomeStep c a] -> SomeRequest
data SomeStep c a where
SomeStep :: (Step c a s) => s -> SomeStep c a
当你运行这样的请求时，它会产生一个最终结果（即最终状态a），它本身必须是存在的。除非您引入一些约束，否则该值对您毫无用处。为简单起见，我们将使用 Show，但如果您计划将结果发送回请求者，ToJSON 可能是一个不错的选择。我们还需要将此约束添加到 SomeRequest 类型：
data SomeRequest where
SomeRequest :: (Show a, Base c b a) => Env c -> b -> [SomeStep c a] -> SomeRequest
data SomeResult where
SomeResult :: (Show a) => a -> SomeResult
为了 运行 一个获得存在结果的存在请求，你会使用类似的东西：
runRequest :: SomeRequest -> SomeResult
runRequest (SomeRequest e b ss) = SomeResult $ execPlan e b (mapM_ runStep ss)
runStep :: SomeStep c a -> RWS (Env c) Log (State a) ()
runStep (SomeStep s) = defineStep s
execPlan :: (Base c b a) => Env c -> b -> Plan c a () -> a
execPlan e b p = case execRWS p e (execBase e b) of (State a, _) -> a
您可以像这样使用 runRequest：
main = do
let r = parseRequest "<some JSON input>"
result = runRequest r
case result of SomeResult r -> print r
现在，我们终于可以解决您的关键问题了。你怎么写：
parseRequest :: String -> SomeRequest
据我所知，这并不是一个真正的 Aeson 问题，并且试图让它成为一个问题会使基本原理复杂化，所以让我们忽略实际的解析，并完成您需要的类型级编程对解析结果执行。
假设我们有以下环境、基础、步骤和 state/result 类型和有效实例：
-- environments (c)
data C1 = C1 Int
data C2 = C2 String
-- bases (b)
data B1 = B1 Double
data B2 = B2 ()
-- steps (s)
data S1 = S1 Double
data S2 = S2 (Maybe Double)
data S3 = S3 ()
-- results (a)
data A1 = A1 Char deriving (Show)
data A2 = A2 Double deriving (Show)
-- valid base instances
instance Base C1 B1 A1
instance Base C2 B1 A1
instance Base C1 B2 A2
-- valid step instances
instance Step C1 A1 S1
instance Step C1 A1 S2
instance Step C2 A1 S2
instance Step C1 A2 S3
我在这里假设您可以将您的环境、基础和步骤解析为求和类型。我知道你有很多基础和步骤，但我看不出有什么方法可以避免将它们全部列举出来。毕竟需要给Aeson完整的有效base集合和完整的有效步骤集合，所以还不如用一个sum类型来驱动解析，作为bases和steps的集中枚举。
-- parse environment
data SomeC = C1_ C1 | C2_ C2
parseC :: String -> SomeC
parseC = undefined
-- parse base
data SomeB = B1_ B1 | B2_ B2
parseB :: String -> SomeB
parseB = undefined
-- parse list of steps
data SomeS = S1_ S1 | S2_ S2 | S3_ S3
parseSList :: String -> [SomeS]
parseSList = undefined
我们需要检查 environment/base 组合的有效性，但是没有办法自动枚举实例，所以我们需要明确所有可能的组合。一种方法是在一系列案例语句中枚举它们：
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1) -> SomeRequest (Env c1) b1 []
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1) -> SomeRequest (Env c2) b1 []
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2) -> SomeRequest (Env c1) b2 []
(_, _) -> error "incompatible environment/base combination"
这适用于空步骤列表。请注意，即使 SomeRequest 调用需要捆绑适当的 Base c b a 词典，也没有关于不明确的 a 类型的错误消息。那是因为函数依赖已经从基类型中调和了它；这就是类型函数 b -> a 在值级别上获得 运行 的方式。在确定类型 b 的大小写匹配之后，调用 SomeRequest 来请求 Base c b a 字典选择适当的 a.
如果我们尝试针对非空步骤列表修改它，我们 运行 会遇到一些问题：
parseRequest inp
= case (parseC inp, parseB inp, parseS inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1, ss) -> SomeRequest (Env c1) b1 ??
在这里，我们有 ss :: [SomeS]，它可以是任何可能的步骤类型的步骤。为了填写 ??，我们需要 Step c a s 字典的类型级证据，将其打包到 SomeRequest.
中的 [SomeStep c a] 字段中
我们可以使用嵌套案例生成这种类型级别的证据，如下所示：
parseRequest inp
= case (parseC inp, parseB inp, parseSList inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1, ss) -> SomeRequest (Env c1) b1 $
map (\s -> case s of
-- instance Step C1 A1 S1
S1_ s1 -> SomeStep s1
-- instance Step C1 A1 S2
S2_ s2 -> SomeStep s2)
ss
...
但这会产生很多情况。
我们仍然无法避免将 Step 个案例的枚举明确化，但最好只考虑相对较少的 c 和 [=27= 类型组合] 并在一个地方为每个步骤列举有效步骤。
最简单的方法就是使用我们现有的 SomeStep existential 为每个 C/A 组合定义一个步骤检查函数：
someStepC1A1 :: SomeS -> SomeStep C1 A1
-- instance Step C1 A1 S1
someStepC1A1 (S1_ s) = SomeStep s
-- instance Step C1 A1 S2
someStepC1A1 (S2_ s) = SomeStep s
someStepC1A1 _ = error "bad step for C1/A1 combination"
someStepC2A1 :: SomeS -> SomeStep C2 A1
-- instance Step C2 A1 S2
someStepC2A1 (S2_ s) = SomeStep s
someStepC2A1 _ = error "bad step for C2/A1 combination"
someStepC1A2 :: SomeS -> SomeStep C1 A2
-- instance Step C1 A2 S3
someStepC1A2 (S3_ s) = SomeStep s
someStepC1A2 _ = error "bad step for C1/A2 combination"
并写入parseRequest以使用适当的功能：
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp, parseSList inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1, ss) -> SomeRequest (Env c1) b1 (someStepC1A1 <$> ss)
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1, ss) -> SomeRequest (Env c2) b1 (someStepC2A1 <$> ss)
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2, ss) -> SomeRequest (Env c1) b2 (someStepC1A2 <$> ss)
(_, _, _) -> error "incompatible environment/base combination"
但是，我们可以通过使 someStep 成为类型类方法来减少一些重复：
class ToSomeStep c a where
someStep :: SomeS -> SomeStep c a
instance ToSomeStep C1 A1 where
-- instance Step C1 A1 S1
someStep (S1_ s) = SomeStep s
-- instance Step C1 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C1/A1 combination"
instance ToSomeStep C2 A1 where
-- instance Step C2 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C2/A1 combination"
instance ToSomeStep C1 A2 where
-- instance Step C1 A2 S3
someStep (S3_ s) = SomeStep s
someStep _ = error "bad step for C1/A2 combination"
并像这样在 parseRequest 中使用它：
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1) -> makeRequest c1 b1
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1) -> makeRequest c2 b1
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2) -> makeRequest c1 b2
(_, _) -> error "incompatible environment/base combination"
where makeRequest :: (Show a, Base c b a, ToSomeStep c a) => c -> b -> SomeRequest
makeRequest c b = SomeRequest (Env c) b (someStep <$> parseSList inp)
正如我所说，我看不出有什么方法可以避免在 parseRequest 中枚举所有有效的 c/b 组合或枚举所有 c/[= someStep 中的 27=]/s 组合。在 parseRequest 中，虽然您不能在没有类型错误的情况下尝试处理无效的 c/b 组合，但仍有可能错过有效组合。类似地，对于 ToSomeStep，类型检查器将阻止您尝试为特定的 c/a 组合允许无效步骤，但如果您错过了有效步骤，它也无济于事。
无论如何，下面是完整的程序类型检查：
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
import Control.Monad.RWS
type Log = ()
type Plan c a = RWS (Env c) Log (State a)
newtype Env c = Env c deriving (Show)
newtype State a = State a
class Base c b a | b -> a where
execBase :: Env c -> b -> State a
class Step c a s where
defineStep :: s -> Plan c a ()
data SomeRequest where
SomeRequest :: (Show a, Base c b a) => Env c -> b -> [SomeStep c a] -> SomeRequest
data SomeStep c a where
SomeStep :: (Step c a s) => s -> SomeStep c a
data SomeResult where
SomeResult :: (Show a) => a -> SomeResult
runRequest :: SomeRequest -> SomeResult
runRequest (SomeRequest e b ss) = SomeResult $ execPlan e b (mapM_ runStep ss)
runStep :: SomeStep c a -> RWS (Env c) Log (State a) ()
runStep (SomeStep s) = defineStep s
execPlan :: (Base c b a) => Env c -> b -> Plan c a () -> a
execPlan e b p = case execRWS p e (execBase e b) of (State a, _) -> a
-- environments (c)
data C1 = C1 Int
data C2 = C2 String
-- bases (b)
data B1 = B1 Double
data B2 = B2 ()
-- steps (s)
data S1 = S1 Double
data S2 = S2 (Maybe Double)
data S3 = S3 ()
-- results (a)
data A1 = A1 Char deriving (Show)
data A2 = A2 Double deriving (Show)
-- valid base instances
instance Base C1 B1 A1
instance Base C2 B1 A1
instance Base C1 B2 A2
-- valid step instances
instance Step C1 A1 S1
instance Step C1 A1 S2
instance Step C2 A1 S2
instance Step C1 A2 S3
-- parse environment
data SomeC = C1_ C1 | C2_ C2
parseC :: String -> SomeC
parseC = undefined
-- parse base
data SomeB = B1_ B1 | B2_ B2
parseB :: String -> SomeB
parseB = undefined
-- parse list of steps
data SomeS = S1_ S1 | S2_ S2 | S3_ S3
parseSList :: String -> [SomeS]
parseSList = undefined
class ToSomeStep c a where
someStep :: SomeS -> SomeStep c a
instance ToSomeStep C1 A1 where
-- instance Step C1 A1 S1
someStep (S1_ s) = SomeStep s
-- instance Step C1 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C1/A1 combination"
instance ToSomeStep C2 A1 where
-- instance Step C2 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C2/A1 combination"
instance ToSomeStep C1 A2 where
-- instance Step C1 A2 S3
someStep (S3_ s) = SomeStep s
someStep _ = error "bad step for C1/A2 combination"
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1) -> makeRequest c1 b1
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1) -> makeRequest c2 b1
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2) -> makeRequest c1 b2
(_, _) -> error "incompatible environment/base combination"
where makeRequest :: (Show a, Base c b a, ToSomeStep c a) => c -> b -> SomeRequest
makeRequest c b = SomeRequest (Env c) b (someStep <$> parseSList inp)
main = do
let r = parseRequest "<some JSON input>"
result = runRequest r
case result of SomeResult r -> print r
为了提高我对 Haskell 的理解，我已经开始了一个个人项目，允许用户组合许多依赖于多态环境和状态的预定义转换。
核心类型围绕 c 参数化的环境、结果类型 a 参数化的状态、c 参数化的类型类 Base 组织并确定 a 的类型，以及一个类型类 Step，它给出了在 RWS monad 中定义用户可选择的转换的接口，并且在 [=13] 上进行了参数化=] 和 a:
type Plan c a = Control.Monad.RWS.RWS (Env c) Log (State a)
data Env c = Env c (Set Condition)
data State a = State a (Set Constraint)
class Base c b a | b -> a where
execBase :: Env c -> b -> (State a, Log)
class Step c a s where
defineStep :: s -> Plan c a ()
-- ^ Plans get folded into a single plan with >>
execPlan :: (Base c b a) => Env c -> b -> Plan c a () -> (a, Log)
代码库的其余部分主要定义了几种不同的数据类型，用户可以将其插入 Env 的 c 部分，一些数据类型可以作为结果 a，以及存在的大量数据类型，用于保存一个或两个参数，并且是 Base 或 Step 的实例。失败的地方在于我无法弄清楚如何从用户提供的 JSON 文档中解析其中的任何内容。我开始于：
data Request c a = Request (Env c) (WrappedBase c a) [WrappedStep c a]
data WrappedBase c a where
WrapBase :: (Base c b a, Eq b, Show b, Typeable a, Typeable b)
=> b -> WrappedBase c a
data WrappedStep c a where
WrapStep :: (Step c a s, Eq s, Show s, Typeable s)
=> s -> WrappedStep c a
但我不知道如何说服 GHC 让我为 Request c a 创建一个 Data.Aeson.FromJSON 实例。编写数据类型 SomeC 是微不足道的，它是 c 所有可能情况的总和类型，并且几乎同样容易为 SomeC 编写解析器以及函数 :: c -> Data.Aeson.Value -> Data.Aeson.Parser (Env c)，但我如何将其转换为 Env c 的解析器，以便我可以将 c 与 Request 中的其他 c 统一起来？
（我也尝试过将解析器转换为连续传递样式，但一旦完成，我意识到我根本没有解决问题。）
还有更深层次的谜团，我如何让 GHC 在值级别执行类型函数 b -> a，这样我就可以在 Request 中使 a 指示 a通过 b 的 Base 实例，或者 return 给用户的消息，让他们知道他们选择的 b 没有为 c 他们指定的？
感觉我想要的是使用类型相等见证，但使用类型 类 而不是类型类型 :: *，但我搜索了 GHC 的大量扩展，但没有找到可以允许。
如果您能够为 Request c a 编写解析器，那将意味着解析 JSON 的结果在 c 和 a 中是多态的，所以调用者可以获取结果并将其用作 Request Int Double，然后用作 Request String Bool，这两种方法都有意义。这可能不是你想要的。
我在这里猜测您有一个环境类型 Env c、基本类型 b 和步骤类型 s 的集合，每个类型都有一个独立的 FromJSON 可以在不知道任何其他类型的情况下解析它的实例。 （因此，例如，一个特定的基类型 MyBase 可以被解析为一个 MyBase 值，而无需知道它将使用的环境 c 或状态 a 类型。）
显然，一个特定的具体请求只涉及一种环境类型 Env c 和一种基本类型 b。我不太清楚步骤列表是打算全部是相同类型的步骤还是不同类型的异构步骤列表，但我假设是后者。如果是这样，您的解析所需的最终结果将是嵌套的存在请求类型：
data SomeRequest where
SomeRequest :: (Base c b a) => Env c -> b -> [SomeStep c a] -> SomeRequest
data SomeStep c a where
SomeStep :: (Step c a s) => s -> SomeStep c a
当你运行这样的请求时，它会产生一个最终结果（即最终状态a），它本身必须是存在的。除非您引入一些约束，否则该值对您毫无用处。为简单起见，我们将使用 Show，但如果您计划将结果发送回请求者，ToJSON 可能是一个不错的选择。我们还需要将此约束添加到 SomeRequest 类型：
data SomeRequest where
SomeRequest :: (Show a, Base c b a) => Env c -> b -> [SomeStep c a] -> SomeRequest
data SomeResult where
SomeResult :: (Show a) => a -> SomeResult
为了 运行 一个获得存在结果的存在请求，你会使用类似的东西：
runRequest :: SomeRequest -> SomeResult
runRequest (SomeRequest e b ss) = SomeResult $ execPlan e b (mapM_ runStep ss)
runStep :: SomeStep c a -> RWS (Env c) Log (State a) ()
runStep (SomeStep s) = defineStep s
execPlan :: (Base c b a) => Env c -> b -> Plan c a () -> a
execPlan e b p = case execRWS p e (execBase e b) of (State a, _) -> a
您可以像这样使用 runRequest：
main = do
let r = parseRequest "<some JSON input>"
result = runRequest r
case result of SomeResult r -> print r
现在，我们终于可以解决您的关键问题了。你怎么写：
parseRequest :: String -> SomeRequest
据我所知，这并不是一个真正的 Aeson 问题，并且试图让它成为一个问题会使基本原理复杂化，所以让我们忽略实际的解析，并完成您需要的类型级编程对解析结果执行。
假设我们有以下环境、基础、步骤和 state/result 类型和有效实例：
-- environments (c)
data C1 = C1 Int
data C2 = C2 String
-- bases (b)
data B1 = B1 Double
data B2 = B2 ()
-- steps (s)
data S1 = S1 Double
data S2 = S2 (Maybe Double)
data S3 = S3 ()
-- results (a)
data A1 = A1 Char deriving (Show)
data A2 = A2 Double deriving (Show)
-- valid base instances
instance Base C1 B1 A1
instance Base C2 B1 A1
instance Base C1 B2 A2
-- valid step instances
instance Step C1 A1 S1
instance Step C1 A1 S2
instance Step C2 A1 S2
instance Step C1 A2 S3
我在这里假设您可以将您的环境、基础和步骤解析为求和类型。我知道你有很多基础和步骤，但我看不出有什么方法可以避免将它们全部列举出来。毕竟需要给Aeson完整的有效base集合和完整的有效步骤集合，所以还不如用一个sum类型来驱动解析，作为bases和steps的集中枚举。
-- parse environment
data SomeC = C1_ C1 | C2_ C2
parseC :: String -> SomeC
parseC = undefined
-- parse base
data SomeB = B1_ B1 | B2_ B2
parseB :: String -> SomeB
parseB = undefined
-- parse list of steps
data SomeS = S1_ S1 | S2_ S2 | S3_ S3
parseSList :: String -> [SomeS]
parseSList = undefined
我们需要检查 environment/base 组合的有效性，但是没有办法自动枚举实例，所以我们需要明确所有可能的组合。一种方法是在一系列案例语句中枚举它们：
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1) -> SomeRequest (Env c1) b1 []
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1) -> SomeRequest (Env c2) b1 []
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2) -> SomeRequest (Env c1) b2 []
(_, _) -> error "incompatible environment/base combination"
这适用于空步骤列表。请注意，即使 SomeRequest 调用需要捆绑适当的 Base c b a 词典，也没有关于不明确的 a 类型的错误消息。那是因为函数依赖已经从基类型中调和了它；这就是类型函数 b -> a 在值级别上获得 运行 的方式。在确定类型 b 的大小写匹配之后，调用 SomeRequest 来请求 Base c b a 字典选择适当的 a.
如果我们尝试针对非空步骤列表修改它，我们 运行 会遇到一些问题：
parseRequest inp
= case (parseC inp, parseB inp, parseS inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1, ss) -> SomeRequest (Env c1) b1 ??
在这里，我们有 ss :: [SomeS]，它可以是任何可能的步骤类型的步骤。为了填写 ??，我们需要 Step c a s 字典的类型级证据，将其打包到 SomeRequest.
[SomeStep c a] 字段中
我们可以使用嵌套案例生成这种类型级别的证据，如下所示：
parseRequest inp
= case (parseC inp, parseB inp, parseSList inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1, ss) -> SomeRequest (Env c1) b1 $
map (\s -> case s of
-- instance Step C1 A1 S1
S1_ s1 -> SomeStep s1
-- instance Step C1 A1 S2
S2_ s2 -> SomeStep s2)
ss
...
但这会产生很多情况。
我们仍然无法避免将 Step 个案例的枚举明确化，但最好只考虑相对较少的 c 和 [=27= 类型组合] 并在一个地方为每个步骤列举有效步骤。
最简单的方法就是使用我们现有的 SomeStep existential 为每个 C/A 组合定义一个步骤检查函数：
someStepC1A1 :: SomeS -> SomeStep C1 A1
-- instance Step C1 A1 S1
someStepC1A1 (S1_ s) = SomeStep s
-- instance Step C1 A1 S2
someStepC1A1 (S2_ s) = SomeStep s
someStepC1A1 _ = error "bad step for C1/A1 combination"
someStepC2A1 :: SomeS -> SomeStep C2 A1
-- instance Step C2 A1 S2
someStepC2A1 (S2_ s) = SomeStep s
someStepC2A1 _ = error "bad step for C2/A1 combination"
someStepC1A2 :: SomeS -> SomeStep C1 A2
-- instance Step C1 A2 S3
someStepC1A2 (S3_ s) = SomeStep s
someStepC1A2 _ = error "bad step for C1/A2 combination"
并写入parseRequest以使用适当的功能：
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp, parseSList inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1, ss) -> SomeRequest (Env c1) b1 (someStepC1A1 <$> ss)
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1, ss) -> SomeRequest (Env c2) b1 (someStepC2A1 <$> ss)
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2, ss) -> SomeRequest (Env c1) b2 (someStepC1A2 <$> ss)
(_, _, _) -> error "incompatible environment/base combination"
但是，我们可以通过使 someStep 成为类型类方法来减少一些重复：
class ToSomeStep c a where
someStep :: SomeS -> SomeStep c a
instance ToSomeStep C1 A1 where
-- instance Step C1 A1 S1
someStep (S1_ s) = SomeStep s
-- instance Step C1 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C1/A1 combination"
instance ToSomeStep C2 A1 where
-- instance Step C2 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C2/A1 combination"
instance ToSomeStep C1 A2 where
-- instance Step C1 A2 S3
someStep (S3_ s) = SomeStep s
someStep _ = error "bad step for C1/A2 combination"
并像这样在 parseRequest 中使用它：
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1) -> makeRequest c1 b1
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1) -> makeRequest c2 b1
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2) -> makeRequest c1 b2
(_, _) -> error "incompatible environment/base combination"
where makeRequest :: (Show a, Base c b a, ToSomeStep c a) => c -> b -> SomeRequest
makeRequest c b = SomeRequest (Env c) b (someStep <$> parseSList inp)
正如我所说，我看不出有什么方法可以避免在 parseRequest 中枚举所有有效的 c/b 组合或枚举所有 c/[= someStep 中的 27=]/s 组合。在 parseRequest 中，虽然您不能在没有类型错误的情况下尝试处理无效的 c/b 组合，但仍有可能错过有效组合。类似地，对于 ToSomeStep，类型检查器将阻止您尝试为特定的 c/a 组合允许无效步骤，但如果您错过了有效步骤，它也无济于事。
无论如何，下面是完整的程序类型检查：
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
import Control.Monad.RWS
type Log = ()
type Plan c a = RWS (Env c) Log (State a)
newtype Env c = Env c deriving (Show)
newtype State a = State a
class Base c b a | b -> a where
execBase :: Env c -> b -> State a
class Step c a s where
defineStep :: s -> Plan c a ()
data SomeRequest where
SomeRequest :: (Show a, Base c b a) => Env c -> b -> [SomeStep c a] -> SomeRequest
data SomeStep c a where
SomeStep :: (Step c a s) => s -> SomeStep c a
data SomeResult where
SomeResult :: (Show a) => a -> SomeResult
runRequest :: SomeRequest -> SomeResult
runRequest (SomeRequest e b ss) = SomeResult $ execPlan e b (mapM_ runStep ss)
runStep :: SomeStep c a -> RWS (Env c) Log (State a) ()
runStep (SomeStep s) = defineStep s
execPlan :: (Base c b a) => Env c -> b -> Plan c a () -> a
execPlan e b p = case execRWS p e (execBase e b) of (State a, _) -> a
-- environments (c)
data C1 = C1 Int
data C2 = C2 String
-- bases (b)
data B1 = B1 Double
data B2 = B2 ()
-- steps (s)
data S1 = S1 Double
data S2 = S2 (Maybe Double)
data S3 = S3 ()
-- results (a)
data A1 = A1 Char deriving (Show)
data A2 = A2 Double deriving (Show)
-- valid base instances
instance Base C1 B1 A1
instance Base C2 B1 A1
instance Base C1 B2 A2
-- valid step instances
instance Step C1 A1 S1
instance Step C1 A1 S2
instance Step C2 A1 S2
instance Step C1 A2 S3
-- parse environment
data SomeC = C1_ C1 | C2_ C2
parseC :: String -> SomeC
parseC = undefined
-- parse base
data SomeB = B1_ B1 | B2_ B2
parseB :: String -> SomeB
parseB = undefined
-- parse list of steps
data SomeS = S1_ S1 | S2_ S2 | S3_ S3
parseSList :: String -> [SomeS]
parseSList = undefined
class ToSomeStep c a where
someStep :: SomeS -> SomeStep c a
instance ToSomeStep C1 A1 where
-- instance Step C1 A1 S1
someStep (S1_ s) = SomeStep s
-- instance Step C1 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C1/A1 combination"
instance ToSomeStep C2 A1 where
-- instance Step C2 A1 S2
someStep (S2_ s) = SomeStep s
someStep _ = error "bad step for C2/A1 combination"
instance ToSomeStep C1 A2 where
-- instance Step C1 A2 S3
someStep (S3_ s) = SomeStep s
someStep _ = error "bad step for C1/A2 combination"
parseRequest :: String -> SomeRequest
parseRequest inp
= case (parseC inp, parseB inp) of
-- instance Base C1 B1 A1
(C1_ c1, B1_ b1) -> makeRequest c1 b1
-- instance Base C2 B1 A1
(C2_ c2, B1_ b1) -> makeRequest c2 b1
-- instance Base C1 B2 A2
(C1_ c1, B2_ b2) -> makeRequest c1 b2
(_, _) -> error "incompatible environment/base combination"
where makeRequest :: (Show a, Base c b a, ToSomeStep c a) => c -> b -> SomeRequest
makeRequest c b = SomeRequest (Env c) b (someStep <$> parseSList inp)
main = do
let r = parseRequest "<some JSON input>"
result = runRequest r
case result of SomeResult r -> print r