Разбор вложенного JSON со случайными целочисленными ключами с использованием aeson

Редактирование вашего ответа показывает, что вы поняли, как решить вашу насущную проблему. Тем не менее, вы можете сделать свой код намного понятнее, избегая большей части явных манипуляций со списками, необходимых для построения вершин. План таков:

• Определите экземпляр FromJSON для Point;

• Используйте его, чтобы определить экземпляр FromJSON для Vertex. Это будет похоже на экземпляр Rule в другом ответе на вопрос, на который вы ссылались, за исключением того, что, поскольку вы хотите использовать ключи объектов в качестве идентификаторов, оператор case будет выглядеть примерно так:

  case M.toList (o :: Object) of
      [(rawID, rawPoint)] -> Vertex (TR.decimal rawId) <$> parseJSON rawPoint
      _                   -> fail "Rule: unexpected format"
  

• Наконец, я полагаю, что ваш существующий экземпляр FromJSON Graph заработает сразу же, если вы измените (предполагаемый) тип vs на [Vertex], учитывая экземпляр FromJSON a => FromJSON [a]. Поэтому parseVertices вам больше не понадобится.

Если у вас есть контроль над структурой JSON, может иметь смысл еще больше упростить ситуацию, сделав идентификаторы вершин полем наряду с x и y, удалив один уровень вложенности.

Обновление: реализация экземпляров на основе того, который вы добавили в свой ответ:

instance FromJSON Point where
  parseJSON (Object v) = liftM2 Point (v .: "x") (v .: "y")
  parseJSON _          = fail "Bad point"

instance FromJSON [Vertex] where
  parseJSON j = case j of
    (Object o) -> mapM parseVertex $ M.toList o
    _          -> fail "Bad vertices"
    where
      parseVertex (rawID, rawPoint) = do
        let eID = TR.decimal rawID
        liftM2 Vertex (either (fail "Bad vertex id") (return . fst) eID) $
          parseJSON rawPoint

instance FromJSON Graph where
  parseJSON (Object v) = do
    i <- parseJSON =<< v .: "id"
    vs <- parseJSON =<< v .: "vertices"
    sc <- parseJSON =<< v .: "scenario"
    return $ Graph i vs sc
  parseJSON _ = fail "Bad graph"

(Получить реализацию в качестве исполняемого примера)

Отличия от вашей версии:

• Вам не нужно определять экземпляр для [Graph]; если вы определите экземпляр Graph, aeson будет автоматически обрабатывать списки (т. е. массивы JS) (обратите внимание, что файл FromJSON упоминается экземпляр FromJSON a => FromJSON [a]. К сожалению, мы не можем сделать то же самое (по крайней мере, не так просто) с [Vertex], учитывая, что идентификаторы вершин являются ключами, а не частью значений.
• Я добавил fail случаев для ошибок сопоставления шаблонов, чтобы получать более информативные сообщения об ошибках.
• Что касается вашего наблюдения о создании вершин из Either значений: ваше решение было довольно разумным. Я только реорганизовал его, используя either (из Data.Either), чтобы предоставить собственное сообщение об ошибке.

Стоит отметить, что код liftM2 (или liftM3 и т. д.) выглядит лучше, если написан в аппликативном стиле. Например, интересным случаем в экземпляре Point может стать:

parseJSON (Object v) = Point <$> v .: "x" <*> v .: "y"

Я только что реализовал решение для простого случая. Вот исходный код:

lookupE :: Value -> Text -> Either String Value
lookupE (Object obj) key = case H.lookup key obj of
        Nothing -> Left $ "key " ++ show key ++ " not present"
        Just v  -> Right v
loopkupE _ _             = Left $ "not an object"

(.:*) :: (FromJSON a) => Value -> [Text] -> Parser a
(.:*) value = parseJSON <=< foldM ((either fail return .) . lookupE) value

instance FromJSON Graph where
  parseJSON (Object v) = do
    i <- parseJSON =<< v .: "id"
    vs <- parseJSON =<< v .: "vertices"
    sc <- parseJSON =<< v .: "scenario"
    buildGraph i sc <$> concat <$> parseVertices vs
      where
        parseVertices v@(Object o) = parseFromTo minID maxID v
          where
            minID = unpackIndex $ Foldable.minimum ids
            maxID = unpackIndex $ Foldable.maximum ids
            unpackIndex eitherI = case eitherI of
              Right i -> i
              Left e -> error e
            ids = map ((fmap fst) . TR.decimal) (M.keys o)

        parseVertex i v = do
          p1 <- v .:* [(T.pack $ show i), "x"]
          p2 <- v .:* [(T.pack $ show i), "y"]
          return $ vertex i p1 p2

        parseFromTo i j v | i == j = return []
                          | otherwise = do
          vertex <- parseVertex i v
          liftM2 (:) (return [vertex]) (parseFromTo (i + 1) j v)

        buildGraph :: Int -> Scenario -> [Vertex] -> Graph
        buildGraph i sc vertices = Graph i vertices sc

  parseJSON _ = mzero

Функции lookupE и (.:*) взяты из Petr Pudlák ответить.

Мне не очень нравится эта реализация функции parseJSON. Но это работает в случаях, когда у моих вершин id с дельтой 1. Я знаю, что не смог извлечь значение из Foldable.minimum ids и Foldable.maximum ids, но это привело меня в монадный ад (маленький).

Итак, вот пример json-файла, после разбора которого мы получили Nothing:

{
    "id": 1,
    "vertices": {
        "3": {
            "y": 12,
            "x": 0
        },
        "2": {
            "y": 16,
            "x": 24
        },
        "1": {
            "y": 12,
            "x": 10
        }
    },
    "scenario": [
        1,
        2,
        3,
        1
    ]
}

Так что пока оставляю этот вопрос открытым.

Обновить

О, я только что увидел свою ошибку. У меня уже есть все ключи. :)

ids = map ((fmap fst) . TR.decimal) (M.keys o)

Теперь я оставляю этот вопрос открытым еще на несколько дней. Может быть, кто-то улучшит мое решение.

Обновление 2

Благодаря duplode я сделал код более понятным и читабельным.

Вот источник:

instance FromJSON Point where
  parseJSON (Object v) = liftM2 Point (v .: "x") (v .: "y")

instance FromJSON [Vertex] where
  parseJSON (Object o) = mapM parseVertex $ M.toList o
    where
      parseVertex (rawID, rawPoint) = Vertex (fromRight . (fmap fst) . TR.decimal $ rawID) <$> parseJSON rawPoint

instance FromJSON Graph where
  parseJSON (Object v) = do
    i <- parseJSON =<< v .: "id"
    vs <- parseJSON =<< v .: "vertices"
    sc <- parseJSON =<< v .: "scenario"
    return $ Graph i vs sc

instance FromJSON [Graph] where
  parseJSON (Object o) = mapM parseGraph $ M.toList o
    where
      parseGraph (_, rawGraph) = parseJSON rawGraph

И мне не нужны никакие вспомогательные функции для извлечения вложенных значений.

Кстати, я не знаю лучшего способа создать Vertex, чем Vertex (fromRight . (fmap fst) . TR.decimal $ rawID) <$> parseJSON rawPoint. liftM2 нельзя использовать, потому что второй аргумент имеет тип Either a b, а третий имеет тип Parser c. Не могу совместить :)