🟠JsonParser.hs

Here's a detailed documentation for the Haskell module JsonParser, tailored to provide an in-depth understanding of its components and functionalities.

Module Documentation: JsonParser

The JsonParser module is designed to parse and serialize JSON data effectively, leveraging Haskell's strong typing and functional paradigms to ensure robust data handling. This module includes comprehensive parsing capabilities for various JSON elements and a custom printer for outputting JSON data in a readable format.

Interface and Functionality Overview

Imported Modules

• Parser: Contains the base Parser type and utility parsing functions, which are fundamental for building JSON-specific parsers.

Data Structures

JsonValue

• Purpose: Represents JSON data in a structured Haskell format.

• Variants:

  • JsonNull: Represents the JSON null value.

  • JsonBool Bool: Represents a JSON boolean.

  • JsonNum Float: Represents a JSON number.

  • JsonString String: Contains a JSON string.

  • JsonArray [JsonValue]: A list of JsonValue, representing a JSON array.

  • JsonObject [(String, JsonValue)]: A list of key-value pairs, representing a JSON object.

Key Functions

Parsing Functions

• parseJsonValue: Parses a string to detect and construct any JsonValue.

• parseJsonNull: Specifically parses the JSON null value.

• parseJsonBool: Parses JSON boolean values (true and false).

• parseJsonNum: Parses JSON numeric values, handling both integers and floats.

• parseJsonStr: Parses JSON string values, managing string delimiters accurately.

• parseJsonArray: Parses sequences of JSON values bracketed by [ and ].

• parseJsonObject: Parses JSON objects enclosed in { and }, processing sequences of key-value pairs.

Serialization Functions

• printJson: Serializes a JsonValue into a human-readable JSON string without indentation.

• printJsonNoIndent: Helper function that recursively serializes JsonValue structures with indentation for better readability.

Error Handling Strategies

• This module uses the Haskell pattern matching and the powerful type system to handle errors gracefully during parsing. Errors in the input data result in parsing failures, which are managed by the underlying Parser module's mechanisms.

{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use newtype instead of data" #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
module JsonParser(parseJsonValue, printJson, JsonValue(..)) where

import Parser(Parser(..), (<|>), parseString, parseFloat, parseChar, parseMany,
    parseAnyChar, parseInt)
import Control.Applicative (optional)

data JsonValue = JsonNull
    | JsonBool Bool
    | JsonNum Float
    | JsonString String
    | JsonArray [JsonValue]
    | JsonObject [(String, JsonValue)]
    deriving (Show)

indent :: String
indent = "    "

ignoreParser :: Parser Char
ignoreParser = parseAnyChar "\n \t\11\12\13\28\29\30\31\133\160"

parseJsonNull :: Parser JsonValue
parseJsonNull = parseString "null" >> return JsonNull

parseJsonBool :: Parser JsonValue
parseJsonBool = (parseString "true" >> return (JsonBool True)) <|>
    (parseString "false" >> return (JsonBool False))

parseJsonNum :: Parser JsonValue
parseJsonNum = JsonNum <$> (parseFloat <|> (fromIntegral <$> parseInt))

parseJsonStr :: Parser JsonValue
parseJsonStr = JsonString <$> (parseChar '"' *> Parser (Just . span (/= '"'))
    <* parseChar '"')

parseJsonArray :: Parser JsonValue
parseJsonArray = do
    parseChar '[' >> parseMany ignoreParser
    end <- optional (parseChar ']')
    case end of
        Just _ -> return (JsonArray [])
        Nothing -> do
            first <- parseJsonValue
            rest <- parseMany (parseChar ',' *> parseJsonValue)
            parseChar ']'
            return (JsonArray (first : rest))

parsePair :: Parser (String, JsonValue)
parsePair = do
    parseMany ignoreParser >> parseChar '"'
    key <- Parser (Just . span (/= '"'))
    parseChar '"' >> parseMany ignoreParser >> parseChar ':'
    parseMany ignoreParser
    value <- parseJsonValue
    parseMany ignoreParser
    return (key, value)

parsePairs :: Parser [(String, JsonValue)]
parsePairs = do
    parseMany ignoreParser
    end <- optional (parseChar '}')
    case end of
        Just _ -> return []
        Nothing -> do
            first <- parsePair
            rest <- parseMany $ parseChar ',' *> parsePair
            return (first : rest)

parseJsonObject :: Parser JsonValue
parseJsonObject = JsonObject <$> (parseChar '{' *> parsePairs <* parseChar '}')

parseJsonValue :: Parser JsonValue
parseJsonValue = parseMany ignoreParser *> (parseJsonNull <|> parseJsonBool
    <|> parseJsonNum <|> parseJsonStr <|> parseJsonArray <|> parseJsonObject)
    <* parseMany ignoreParser

makeIndent :: Int -> String
makeIndent 0 = "\n"
makeIndent i = makeIndent (i - 1) ++ indent

printJsonNoIndent :: Int -> JsonValue -> String
printJsonNoIndent _ JsonNull = "null"
printJsonNoIndent _ (JsonBool True) = "true"
printJsonNoIndent _ (JsonBool False) = "false"
printJsonNoIndent _ (JsonNum x) | x == fromIntegral (round x) = show (round x)
    | otherwise = show x
printJsonNoIndent _ (JsonString s) = "\"" ++ s ++ "\""
printJsonNoIndent i (JsonArray a) = "[" ++ makeIndent (i + 1) ++
    foldr (\x acc -> case acc of
    [] -> printJsonNoIndent (i + 1) x
    str -> printJsonNoIndent (i + 1) x ++ "," ++
        makeIndent (i + 1) ++ str) "" a ++ makeIndent i ++"]"
printJsonNoIndent i (JsonObject s) = "{" ++ makeIndent (i + 1) ++
    foldr (\(k,v) acc -> case acc of
    [] -> "\"" ++ k ++ "\": " ++ printJsonNoIndent (i + 1) v
    str -> "\"" ++ k ++ "\": " ++ printJsonNoIndent (i + 1) v ++ "," ++
        makeIndent (i + 1) ++ str) "" s ++ makeIndent i ++ "}"

printJson :: JsonValue -> String
printJson = printJsonNoIndent 0