如何在 Haskell 中解析带有可选和变体类型字段的 json？

Question

How I can parse the input json inside this file ? https://github.com/smogon/pokemon-showdown/blob/master/data/moves.js

For the secondary and flags properties? They are optional and contains variant type.

A minimal example would be this one:

[
  {},
  {
    "secondary": false
  },
  {

    "secondary": {
      "chance": 10,
      "boosts": {
        "spd": -1
      }
    }
  },
  {
    "secondary": {
      "chance": 30,
      "volatileStatus": "flinch"
    }
  },
  {
    "secondary": {
      "chance": 30
    }
  },
  {
    "secondary": {
      "chance": 10,
      "self": {
        "boosts": {
          "atk": 1,
          "def": 1,
          "spa": 1,
          "spd": 1,
          "spe": 1
        }
      }
    }
  },
  {
    "secondary": {
      "chance": 10,
      "status": "brn"
    }
  },
  {
    "secondary": {
      "chance": 50,
      "self": {
        "boosts": {
          "def": 2
        }
      }
    }
  },
  {
    "secondary": {
      "chance": 100,
      "self": {}
    }
  },
  {
    "secondary": {
      "chance": 50,
      "boosts": {
        "accuracy": -1
      }
    }
  }
]

For your convenience, you can choose to attach this snippet to the end of the js file and run it using node move.js . Two valid json files will be saved to your disk. One is a list of json objects while the other is an object with string as key.

var fs = require('fs');
fs.writeFile("moves_object.json", JSON.stringify(BattleMovedex), function(err) {}); // 1. save a json object with string key

var jsonList = []
for (var key of Object.keys(BattleMovedex)) {
    jsonList.push(BattleMovedex[key]);
}
fs.writeFile("moves.json", JSON.stringify(jsonList), function(err) { // 2. save as a list of json object
    if (err) {
        console.log(err);
    }
});

FYI : If you are familiar with c++, you might find it easier to understand the same problem in this post:

How to parse json file with std::optional< std::variant > type in C++?

Answer 1

NOTE : In the code examples below, I've used a "moves.json" file whose contents are your minimal example above. Except for getMoves , which can parse any valid JSON, the other code examples won't work on the "moves.json" file derived from the linked "moves.js" file because the format is different (eg, it's an object, not an array, for one thing).

The simplest way of using Aeson to parse arbitrary JSON is to parse it to a Value :

import Data.Aeson
import Data.Maybe
import qualified Data.ByteString.Lazy as B

getMoves :: IO Value
getMoves = do
  mv <- decode <$> B.readFile "moves.json"
  case mv of
    Nothing -> error "invalid JSON"
    Just v -> return v

Any valid JSON can be parsed this way, and the resulting Value has completely dynamic structure that can be programmatically inspected at runtime. The Lens library and Maybe monad can be helpful here. For example, to find the (first) object with a non-missing secondary.chance of 100, you could use:

{-# LANGUAGE OverloadedStrings #-}

import Control.Lens
import Data.Aeson
import Data.Aeson.Lens
import qualified Data.Vector as Vector
import qualified Data.ByteString.Lazy as B

find100 :: Value -> Maybe Value
find100 inp = do
  arr <- inp ^? _Array
  Vector.find (\s -> s ^? key "secondary" . key "chance" . _Integer == Just 100) arr

test1 = find100 <$> getMoves

which outputs:

> test1
Just (Object (fromList [("secondary",Object (fromList [("chance",Number 100.0),
("self",Object (fromList []))]))]))

which is the Value representation of the object:

{
  "secondary": {
    "chance": 100,
    "self": {}
  }
}

If you want the resulting parsed object to have more structure, then you need to start by figuring out a Haskell representation that will work with all possible objects you're planning to parse. For your example, a reasonable representation might be:

type Moves = [Move]

data Move = Move
  { secondary :: Secondary'
  } deriving (Show, Generic)

newtype Secondary' = Secondary' (Maybe Secondary) -- Nothing if json is "false"
  deriving (Show, Generic)

data Secondary = Secondary
  { chance :: Maybe Int
  , boosts :: Maybe Boosts
  , volatileStatus :: Maybe String
  , self :: Maybe Self
  } deriving (Show, Generic)

data Self = Self
  { boosts :: Maybe Boosts
  } deriving (Show, Generic)

newtype Boosts = Boosts (HashMap.HashMap Text.Text Int)
  deriving (Show, Generic)

This assumes that all moves have a secondary field which is either "false" or an object. It also assumes that lots of boost keys are possible, so it's more convenient to represent them as arbitrary text strings in a Boosts hashmap. Also, this handles having the "boosts" directly under "secondary" or nested within "self" , since your example included examples of both forms, though maybe this was a mistake.

For these data types, the default instances for Move , Self , and Secondary can all be used:

instance FromJSON Move
instance FromJSON Self
instance FromJSON Secondary

The Secondary' newtype wrapper around Secondary is then used to handle false versus an object using a custom instance:

instance FromJSON Secondary' where
  parseJSON (Bool False) = pure $ Secondary' Nothing
  parseJSON o = Secondary' . Just <$> parseJSON o

A custom instance is also needed for Boosts to parse it into the appropriate hashmap:

instance FromJSON Boosts where
  parseJSON = withObject "Boosts" $ \o -> Boosts <$> mapM parseJSON o

Now, with the following driver:

test2 :: IO (Either String Moves)
test2 = eitherDecode <$> B.readFile "moves.json"

this decodes your example like so:

> test2
Right [Move {secondary = Secondary' Nothing},Move {secondary =
Secondary' (Just (Secondary {chance = Just 10, boosts = Just (Boosts
(fromList [("spd",-1)])), volatileStatus = Nothing, self =
...

By using eitherDecode above, we can get an error message if the parse fails. For example, if you run this on the "moves.json" derived from "moves.js" instead, you get:

> test2
Left "Error in $: parsing [] failed, expected Array, but encountered Object"

when the parser notices that it's trying to parse a [Move] array but is instead finding an object keyed by Pokemon move names.

Here's the full code showing both types of parsing:

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Lens
import Data.Aeson
import Data.Aeson.Lens
import GHC.Generics
import qualified Data.Text as Text
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Vector as Vector
import qualified Data.ByteString.Lazy as B

--
-- Parse into a dynamic Value representation

getMoves :: IO Value
getMoves = do
  mv <- decode <$> B.readFile "moves.json"
  case mv of
    Nothing -> error "invalid JSON"
    Just v -> return v

find100 :: Value -> Maybe Value
find100 inp = do
  arr <- inp ^? _Array
  Vector.find (\s -> s ^? key "secondary" . key "chance" . _Integer == Just 100) arr

test1 :: IO (Maybe Value)
test1 = find100 <$> getMoves

--
-- Parse into suitable static data structures

-- whole file is array of moves
type Moves = [Move]

data Move = Move
  { secondary :: Secondary'
  } deriving (Show, Generic)

newtype Secondary' = Secondary' (Maybe Secondary) -- Nothing if json is "false"
  deriving (Show, Generic)

data Secondary = Secondary
  { chance :: Maybe Int
  , boosts :: Maybe Boosts
  , volatileStatus :: Maybe String
  , self :: Maybe Self
  } deriving (Show, Generic)

data Self = Self
  { boosts :: Maybe Boosts
  } deriving (Show, Generic)

newtype Boosts = Boosts (HashMap.HashMap Text.Text Int)
  deriving (Show, Generic)

instance FromJSON Move
instance FromJSON Self
instance FromJSON Secondary

instance FromJSON Secondary' where
  parseJSON (Bool False) = pure $ Secondary' Nothing
  parseJSON o = Secondary' . Just <$> parseJSON o

instance FromJSON Boosts where
  parseJSON = withObject "Boosts" $ \o -> Boosts <$> mapM parseJSON o

test2 :: IO (Either String Moves)
test2 = eitherDecode <$> B.readFile "moves.json"

Answer 2

My attempt to the minimal sample

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}


module Main where

import Data.Text
import GHC.Generics
import Data.Aeson

main :: IO ()
main = do
  result <- eitherDecodeFileStrict "/tmp/helloworld/minimal.json"
  print (result :: Either String [Foo])

data Foo = Foo { secondary :: Either Bool Bar } deriving (Generic, Show)
data Bar = Chance
  { chance :: Int
  , volatileStatus :: Maybe Text
  , boosts :: Maybe Boosts
  , self :: Maybe Self
  , status :: Maybe Text
  } deriving (Generic, Show)

data Boosts = Boosts
  { atk :: Maybe Int
  , def :: Maybe Int
  , spa :: Maybe Int
  , spd :: Maybe Int
  , spe :: Maybe Int
  } deriving (Generic, Show)

data Self = Self
  { boosts :: Maybe Boosts
  } deriving (Generic, Show)

instance FromJSON Foo where
  parseJSON (Object v) = do
    sd <- v .: "secondary"  -- Parse Value
    case sd of
      Bool x -> return . Foo . Left $ x
      otherwise -> (Foo . Right) <$> parseJSON sd
instance FromJSON Bar
instance FromJSON Boosts
instance FromJSON Self

Answer 3

here is another attempt to your mover.json

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}


module Main where

import Control.Applicative
import Data.Maybe
import Data.Text (Text)
import GHC.Generics
import Data.Aeson

main :: IO ()
main = do
  result <- eitherDecodeFileStrict "/tmp/helloworld/movers.json" 
  case ( result :: Either String [Move]) of
    Left error -> print error
    Right ms -> print (length ms)

data Move = Move
  { num :: Int
  , accuracy :: Either Int Bool
  , secondary :: Maybe (Either Bool Secondary)
  } deriving (Generic, Show)

data Secondary = Secondary
  { chance :: Maybe Int
  , volatileStatus :: Maybe Text
  , boosts :: Maybe Boosts
  , self :: Maybe Self
  , status :: Maybe Text
  } deriving (Generic, Show)

data Boosts = Boosts
  { atk :: Maybe Int
  , def :: Maybe Int
  , spa :: Maybe Int
  , spd :: Maybe Int
  , spe :: Maybe Int
  } deriving (Generic, Show)

data Self = Self
  { boosts :: Maybe Boosts
  } deriving (Generic, Show)

instance FromJSON Move where
  parseJSON (Object v) = Move
    <$> v .: "num"
    <*> (   (Left  <$> v .: "accuracy")
        <|> (Right <$> v .: "accuracy")
        )
    <*> (   fmap (fmap Left)  (v .:? "secondary")
        <|> fmap (fmap Right) (v .:? "secondary")
        )

instance FromJSON Secondary
instance FromJSON Boosts
instance FromJSON Self