解析时构建 GADT json

Question

我有一个用 GADT 创建的数据结构，我想使用 aeson 将一些 json 解析到这个 GADT。但是类型检查器抱怨说在所有情况下都只能创建 GADT 的构造函数之一。看这个例子：

data Foo = Hello | World

data SFoo :: Foo -> Type where
  SHello :: SFoo 'Hello 
  SWorld :: SFoo 'World

instance FromJSON (SFoo a) where
  parseJSON = withText "Foo" \case
    "hello" -> pure SHello
    "world" -> pure SWorld

所以我希望能够将“hello”字符串解析为 SHello，将“world”字符串解析为 SWorld。类型检查器抱怨以下错误：

• Couldn't match type ‘'World’ with ‘'Hello’
  Expected type: Parser (SFoo 'Hello)
    Actual type: Parser (SFoo 'World)
• In the expression: pure SWorld
  In a case alternative: "world" -> pure SWorld
  In the second argument of ‘withText’, namely
    ‘\case
       "hello" -> pure SHello
       "world" -> pure SWorld’

如何将一些 json 解析为这样的 GADT 结构？

Answer 1

这个

instance FromJSON (SFoo a) where

不会飞。你会得到

parseJSON :: forall a. Value -> Parser (SFoo a)

这意味着调用者可以选择他们想要的 a，并且 parseJSON 无法控制从 JSON 解析 a。相反，你想要

data SomeFoo = forall a. SomeFoo (SFoo a)
instance FromJSON SomeFoo where
    parseJSON = withText "Foo" \case
        "hello" -> pure $ SomeFoo SHello
        "world" -> pure $ SomeFoo SWorld
        _ -> fail "not a Foo" -- aeson note: without this you get crashes!

现在在哪里

fromJSON :: Value -> Result SomeFoo

不会告诉您 SFoo 的哪个分支将以其类型返回。 SomeFoo 现在是一对 a :: Foo 类型和 SFoo a 值。 fromJSON 现在负责解析整个对，因此它控制返回的类型和值。当您使用它并在 SomeFoo 上进行匹配时，that 将告诉您必须处理哪种类型：

example :: Value -> IO ()
example x = case fromJSON x of
    Error _ -> return ()
    Success (SomeFoo x) -> -- know x :: SFoo a where a is a type extracted from the match; don't know anything about a yet
        case x of
            SHello -> {- now know a ~ Hello -} return ()
            SWorld -> {- now know a ~ World -} return ()

请注意 SomeFoo 基本上与 Foo 同构。你不妨写

instance FromJSON Foo where ..

然后

someFoo :: Foo -> SomeFoo
someFoo Hello = SomeFoo SHello
someFoo World = SomeFoo SWorld
instance FromJSON SomeFoo where parseJSON = fmap someFoo . parseJSON

请注意，您可以编写以下两个实例：

instance FromJSON (SFoo Hello) where
    parseJSON = withText "SFoo Hello" \case
        "hello" -> pure SHello
        _ -> fail "not an SFoo Hello"
instance FromJSON (SFoo World) where
    parseJSON = withText "SFoo World" \case
        "world" -> pure SWorld
        _ -> fail "not an SFoo World"

...但它们不是特别有用，除非作为另一种写法 FromJSON SomeFoo:

instance FromJSON SomeFoo where
    parseJSON x = prependFailure "SomeFoo: " $
        SomeFoo @Hello <$> parseJSON x <|> SomeFoo @World <$> parseJSON x

解析时构建 GADT json

Construct GADT while parsing json

haskell

text-parsing

aeson

gadt