如何使用 Haskell/Aeson 中的类型函数解析多态值？

Question

为了加深对 Haskell 的理解，我开始了一个个人项目，该项目允许用户组合许多不同的预定义转换，这些转换依赖于多态的环境和状态。

核心类型围绕通过c 参数化的环境、通过结果类型a 参数化的状态、通过c 参数化并确定a 类型的类型类Base 进行组织，以及一个类型类Step，它提供了在RWS monad 中定义用户可选转换的接口，并通过c 和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 中的其他cs 统一起来？

（我也尝试将解析器转换为延续传递样式，但是一旦我这样做了就意识到我根本没有解决问题。）

还有更深层次的谜团，我如何让 GHC 在值级别执行类型函数 b -> a，以便我可以在 Request 中使 a 由 @ 的 Base 实例指示的 a 987654351@ 或者向用户返回一条消息，让他们知道他们选择的b 不是为他们指定的c 定义的？

感觉我想要的是使用类型相等见证，但使用类型类而不是类型 :: *，但我搜索了 GHC 的扩展丛林，但没有找到允许这样做的东西。

Answer 1

如果您能够为Request c a 编写解析器，这意味着解析JSON 的结果在c 和a 中是多态的，因此调用者可以获取结果并将其用作@ 987654324@，然后是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 问题，并且试图使其成为一个会使基本原理复杂化的问题，所以让我们忽略实际的解析，并通过您需要执行的类型级编程解析结果。

假设我们有以下环境、基础、步骤和状态/结果类型和有效实例：

-- 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全套有效碱基和全套有效步骤，所以你不妨使用sum类型来驱动解析，作为碱基和步骤的集中枚举。

-- 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

我们需要检查环境/基础组合的有效性，但无法自动枚举实例，因此我们需要明确所有可能的组合。一种方法是在一系列案例陈述中列举它们：

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 和 a 的组合并为每个案例枚举有效步骤那些在一个地方。

最简单的方法是使用我们现有的SomeStepexistential 为每个 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 组合或在someStep 中枚举所有c/a/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