TD 8

Parser du JSON

JSON est un format d’échange de données structurées. Ce format a l’avantage d’être très simple à utiliser. En effet, les données sont représentées dans un format textuel qui utilise une syntaxe compatible avec celle du langage de programmation JavaScript.

Dans la suite, nous ne considérerons que les constructions principales de JSON.

Le modèle de données que l’on considère est le suivant :

data JSON = JsonNull
          | JsonBool Bool
          | JsonInt Int
          | JsonFloat Float
          | JsonString String
          | JsonArray [JSON]
          | JsonObject [(String, JSON)]

1. Gestion des blancs

En dehors des chaînes de caractères, les caractères blancs n’ont pas d’importance dans un document JSON. On va donc écrire une fonction passeBlancs qui, prenant un parseur p en argument, renvoie un parseur qui :

  • exécute p ;
  • passe tous les blancs présents en début de la chaîne qui reste à analyser ;
  • retourne la valeur calculée par p.

On va utiliser la fonction isSpace :: Char -> Bool qui reconnaît les caractères blancs.

passeBlancs :: Parser a -> Parser a
passeBlancs p =   p -- on exécute p
              >>= \a -> many (carQuand isSpace) -- on garde le résultat et parse les espaces
              >>  return a -- on jette les espaces et on renvoie le résultat de p

Désormais, lorsque nous analyserons un élément d’un document JSON, nous prendrons la convention de passer les blancs qui le suivent. On ne le fera que pour les parsers qui construisent un élément JSON.

2. Reconnaître null

On va reconnaître la chaîne de caractères "null" pour construire la valeur JSON correspondante.

parseNull :: Parser JSON -- le type qu'on va renvoyer c'est JSON
parseNull = passeBlancs (chaine "null") -- si on reconnait la chaine "null"
          >> return JsonNull -- on renvoie une valeur JSON correspondante

3. Reconnaître les booléens

Pour les booléens, c’est un peu différent, mais pas tant que ça. Il faut toujours reconnaître une chaîne de caractères, mais on en a deux possibles.

On peut imaginer quelque chose comme

parseTrue :: Parser Bool
parseTrue = chaine "true" >> return True

Mais ça ne renvoie pas une valeur de type JSON. Il faut qu’on applique un constructeur à cette valeur. Il faut aussi qu’on passe les blancs.

Une solution (ce n’est pas la seule, mais elle évite de répéter du code) serait :

parseBool :: Parser JSON
parseBool = JsonBool <$> -- on applique le constructeur au résultat
          passeBlancs (parseTrue <|> parseFalse) -- au premier qui réussit

Ici, on utilise le fait que notre module Parser soit alternatif.

4. Tout sauf certains caractères

Quand on va parser des chaînes de caractères, il va falloir que l’on sache reconnaître tous les caractères qui sont entre deux guillemets, mais qui ne sont pas des guillemets.

Pour s’aider, on va faire un parseur toutSauf, qui étant donné une chaîne de caractères, accepte tout caractère qui n’est pas dans cette liste.

ghci> runParser (toutSauf ['a','b']) "ac"
Nothing
ghci> runParser (toutSauf ['a','b']) "bc"
Nothing
ghci> runParser (toutSauf ['a','b']) "c"
Just ('c',"")
ghci> runParser (toutSauf ['a','b']) ""
Nothing
toutSauf :: [Char] -> Parser Char
toutSauf cs = carQuand (\c -> not (elem c cs))
-- on reconnait le caractère s'il n'est pas dans la liste

5. Parser une chaîne

On va écrire un parseur qui reconnaît tout le texte inclus entre des guillemets.

chaineP :: Parser String
chaineP = car '"' -- ouverture de la chaine
        >> many (toutSauf ['"']) -- on peut avoir une chaine vide
        >>= \s -> car '"' -- fermeture de la chaine
        >> return s -- on renvoie la chaine

6. Reconnaître les chaînes JSON

Maintenant qu’on sait reconnaître une chaine de caractères, on veut la convertir en valeur JSON.

parseChaine :: Parser JSON
parseChaine = passeBlancs (chaineP) >>= \s -> return (JsonString s)
           -- passeBlancs (chaineP) >>= return . JsonString

7. Concaténation de résultats

Si on a deux parseurs qui renvoient chacun une liste d’éléments du même type, on va définir la concaténation entre les résultats.

(<++>) :: Parser [a] -> Parser [a] -> Parser [a]
p1 <++> p2 = (++) <$> p1 <*> p2

On exécute donc p1, puis p2 et on concatène les deux résultats.

8. Chaine optionnelle

On va définir un parseur qui reconnaît une chaîne si elle est bien au début du texte à analyser et qui renvoie la chaîne vide sinon.

chaineOption :: String -> Parser String
chaineOption s = chaine s <|> return ""

9. Parser des nombres

On va écrire un parseur qui va reconnaître une chaîne de caractères composée uniquement de chiffres. On utilise pour ça la fonction bien nommée isDigit.

nombre :: Parser String
nombre = some (carQuand isDigit)

10. Reconnaître les entiers

Un entier, c’est une séquence non vide de chiffres, précédée ou non du signe "-". On veut parser la chaîne correspondante et la renvoyer sous la forme d’une valeur JSON.

parseInt :: Parser JsonInt
parseInt = JsonInt <$> passeBlancs entier -- on convertit en JSON
    where
        entier = read <$> (chaineOption "-" <++> nombre)
        -- on lit (peut-être) "-" puis un nombre et on convertit en entier

11. Reconnaître les flottants

Même principe, mais on veut reconnaître des flottants simplifiés. Ils sont écrits sous la forme d’un nombre suivi d’un point suivi d’un nombre. Ils peuvent aussi être négatifs.

parseFloat :: Parser JsonFloat
parseFloat = JsonFloat <$> passeBlancs flott -- on convertit en JSON
where
flott = read <$> (chaineOption "-" <++> nombre <++> chaine "." <++> nombre)
-- on lit (peut-être) "-" puis un nombre puis "." puis un nombre et on convertit en flottant

Pour la suite, on va définir 3 parseurs mutuellement récursifs :

  • parseArray, qui va parser des listes JSON
  • parseObject, qui va parser des objets JSON
  • parseJson, qui va parser n’importe quel JSON

12. Reconnaître du JSON

On va vouloir renvoyer la valeur JSON quelle qu’elle soit.

parseJson :: Parser JSON
parseJson = parseNull     -- soit un null
         <|> parseBool    -- soit un bool
         <|> parseFloat   -- soit un flottant (avant l'entier sinon on va toujours avoir un entier)
         <|> parseInt     -- soit un entier
         <|> parseChaine  -- soit une chaine
         <|> parseArray   -- soit une liste
         <|> parseObject  -- soit un objet

13. Itérations avec virgules

Dans les listes et les objets, on a des éléments qui sont séparés par des virgules. On va donc définir des parseurs qui permettent de reconnaître des listes d’éléments séparés ainsi.

On commence par reconnaître une virgule et la jeter.

virgule :: Parser ()
virgule = passeBlancs (car ',') >> return ()

Ensuite, on va définir un parseur qui va fonctionner comme some p, mais qui avant chaque application de p (après la première), passe la virgule.

unOuPlusVirg :: Parser a -> Parser [a]
unOuPlusVirg p = (:) <$> p <*> many (virgule >> p)

On peut étendre ce parseur pour reconnaître les listes vides également.

zeroOuPlusVirg :: Parser a -> Parser [a]
zeroOuPlusVirg p = unOuPlusVirg p <|> return [] -- si on a pas un élément au moins, on renvoie la liste vide

14. Reconnaître les listes

On va maintenant pouvoir parser des listes. Une liste en JSON est une suite d’éléments séparés par des virgules, le tout dans des crochets.

On peut donc tout simplement faire :

parseArray :: Parser JSON
parseArray = passeBlancs (car '[') -- on ouvre la liste
           >> zeroOuPlusVirg parseJson -- on parse 0 ou plus éléments JSON
           >>= \l -> passeBlancs (car ']') -- on ferme la liste
           >> return $ JsonArray l -- on renvoie la liste dans le bon constructeur

15. Parser des paires clé-valeur

Pour les objets, c’est un peu plus compliqué : il faut qu’on reconnaisse une paire constituée d’une clé (un String) et d’une valeur (un JSON), séparée par un ':'.

On écrit donc un petit parseur pour s’aider :

cleValeur :: Parser (String, JSON)
cleValeur = chaineP -- on reconnait la clé
          >>= \cle -> passeBlancs (car ':') -- on passe le séparateur
          >> parseJson -- on reconnait la valeur
          >>= \valeur -> return (cle, valeur) -- on renvoie la paire

16. Reconnaître des objets

On peut maintenant reconnaître facilement des objets, qui sont une suite séparée par des virgules de paires clé-valeur, le tout enclos dans des accolades.

parseObject :: Parser JSON
parseObject = passeBlancs (car '{') -- on commence l'objet
            >> zeroOuPlusVirg cleValeur -- on parse 0 ou plus paires
            >>= \paires -> passeBlancs (car '}') -- on termine l'objet
            >> return $ JsonObject paires -- on renvoie la liste des paires dans le bon constructeur

17. Reconnaître un caractère échappé

Le format des chaînes de caractères que nous avons parsé est simpliste : nous voulons pouvoir mettre des '"' dans les chaînes. Suivant le format utilisé dans beaucoup de langages (Haskell, Java, C, JavaScript, etc.), JSON utilise '\' comme caractère d’échappement, c’est-à-dire que les deux caractères '\"' dans la représentation d’une chaîne signifient que la chaîne contient un '"'. Il faut du coup aussi représenter '\' par '\\'. Cette mécanique est aussi utile pour les retours à la ligne, codés '\n', etc.

On va coder un parseur qui permet de remplacer une suite de caractères échappés par le bon caractère. Pour ça, on va lui donner une paire dont le premier élément est le caractère suivant le slash, et le deuxième est le caractère par lequel le remplacer.

echappement :: (Char, Char) -> Parser Char
echappement (c, r) = car '\\' -- si on a le slash
                   >> car c  -- qui est suivi par c
                   >> return r -- alors on renvoie r

18. Reconnaître des caractères échappés

On va avoir une liste des échappements possibles, comme par exemple :

listeEchappements :: [(Char,Char)]
listeEchappements = [('n', '\n'), ('t', '\t'), ('"', '"'), ('\\', '\\')]

Pour se simplifier le travail, on va écrire un parseur qui va reconnaître tous les échappements de la liste. Comme on a déjà fait le travail pour un seul caractère, et qu’on va vouloir faire une alternative entre les caractères, on peut tout simplement replier la liste.

echappements :: Parser Char
echappements = foldl (\p (c, r) -> p <|> echappement (c, r)) empty listeEchappements

19. Chaînes contenant des échappements

On va maintenant mettre à jour notre parseur de chaîne pour qu’il accepte les échappements.

On va donc reconnaître tout sauf un guillemet ou un slash ou bien un échappement.

chaineP :: Parser String
chaineP = car '"' -- toujours l'ouverture de la chaîne
        >> many (echappements <|> toutSauf "\\\"") -- un échappement ou tout sauf / ou "
        >>= \s -> car '"' -- la fermeture de la chaîne
        >> return s

Transformation de fichiers JSON

Tout ça, c’est bien, mais on prend une chaîne de caractères en entrée. Dans la vraie vie, le texte est souvent contenu dans un fichier. On peut aussi vouloir écrire notre représentation sous la forme d’un texte JSON.

1. De JSON à JSON

On va écrire une fonction jsonToString qui va prendre une valeur JSON et la transformer en chaîne de caractères JSON valide, soit l’inverse du parseur.

Pour avoir une représentation plus compacte, on ne va pas mettre de retour à la ligne et limiter les espaces entre les éléments.

On utilisera show et intercalate (join en Python)

jsonToString :: JSON -> String
jsonToString JsonNull         = "null" -- facile
jsonToString (JsonBool True)  = "true" -- facile
jsonToString (JsonBool False) = "false" -- facile
jsonToString (JsonInt n)      = show n -- ne pas oublier le show pour passer en string
jsonToString (JsonFloat f)    = show f -- pareil
jsonToString (JsonString s)   = show s -- ici, on met le show pour rajouter les guillemets
jsonToString (JsonArray l)    = "[" ++ intercalate "," (map jsonToString l) ++ "]"
                                -- on ajoute une virgule entre chaque élément, et on les convertit tous en string
jsonToString (JsonObject o)   = "{" ++ intercalate "," (map kv o) ++ "}"
    where
        kv (k, v) = show k ++ ": " ++ jsonToString v
                                -- on ajoute une virgule entre chaque élément, et on convertit les paires

2. De JSON à YAML

On va maintenant convertir notre valeur JSON en valeur YAML, qui est un autre format d’échange de données.

On va utiliser show et unlines, qui concatène des chaînes avec des retours à la ligne.

Comme on n’a plus de séparateur comme en JSON, on va utiliser une fonction auxilliaire pour afficher le texte à la bonne indentation.

jsonToYaml :: JSON -> String
jsonToYaml = yamlAux ""
    where
        yamlAux indent JsonNull = indent ++ "null"
        yamlAux indent (JsonBool True) = indent ++ "true"
        yamlAux indent (JsonBool False) = indent ++ "false"
        yamlAux indent (JsonInt n) = indent ++ show n
        yamlAux indent (JsonFloat f) = indent ++ show f
        yamlAux indent (JsonString s) = indent ++ show s
        yamlAux indent (JsonArray l) = unlines (map mkArray l)
            where
                mkArray j = indent ++ "- " ++ yamlAux indent j -- on ajoute un tiret
        yamlAux indent (JsonObject l) = unlines (map kv l)
            where
                kv (s,j) = indent ++ show s ++ ":\n" ++ yamlAux ("  " ++ indent) j -- on étend l'indentation

3. Transformation de fichiers

On veut maintenant écrire une fonction qui va lire un fichier JSON, le parser, le convertir en chaîne et l’écrire dans un nouveau fichier.

Notre fonction a donc le type jsonFileConvert :: (JSON -> String) -> FilePath -> FilePath -> IO ().

On va utiliser les fonctions :

  • readFile :: FilePath -> IO String et
  • writeFile :: FilePath -> String -> IO ()
jsonFileConvert :: (JSON -> String) -> FilePath -> FilePath -> IO ()
jsonFileConvert transf in out = do
    inString <- readFile in -- inString est donc de type String suite à l'action de readFile
    let json = evalParser parseJson inString -- on lance le parseur sur le string
    case json of
        Nothing -> putStrLn "Erreur de parsing -- fichier invalide" -- on affiche un message en cas d'erreur
        Just jv -> writeFile out (transf jv) -- on écrit dans le fichier de sortie la nouvelle chaine

4. JSON mini et JSON YAML

On peut utiliser cette fonction pour construire des fonctions qui écrivent une version simplifiée du JSON ou une version YAML.

fileJsonMini :: FilePath -> FilePath -> IO ()
fileJsonMini = jsonFileConvert jsonToString

fileJsonYaml :: FilePath -> FilePath -> IO ()
fileJsonYaml = jsonFileConvert jsonToYaml