Last active
August 29, 2022 13:31
-
-
Save frndmg/478f5c00b11e1893a8909ea0a9599ea7 to your computer and use it in GitHub Desktop.
JSON Parser
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- Inspired on the video from [Tscoding](https://youtu.be/N9RUqGYuGfw) | |
import Control.Applicative (Alternative, empty, many, (<|>)) | |
import Data.Char (isDigit, isSpace) | |
data JsonValue | |
= JsonNull | |
| JsonBool Bool | |
| JsonInteger Int | |
| JsonFloat Float | |
| JsonString String | |
| JsonArray [JsonValue] | |
| JsonObject [(String, JsonValue)] | |
deriving (Show) | |
newtype Parser a = Parser | |
{ runParser :: String -> Maybe (String, a) | |
} | |
instance Functor Parser where | |
fmap f (Parser a) = Parser $ \input -> do | |
(input', x) <- a input | |
return (input', f x) | |
instance Applicative Parser where | |
pure a = Parser $ \input -> Just (input, a) | |
(Parser a) <*> (Parser b) = Parser $ \input -> do | |
(input', f) <- a input | |
(input'', x) <- b input' | |
return (input'', f x) | |
instance Alternative Parser where | |
empty = Parser $ const Nothing | |
(Parser a) <|> (Parser b) = Parser go | |
where | |
go input = a input <|> b input | |
charP :: Char -> Parser Char | |
charP c = Parser go | |
where | |
go :: String -> Maybe (String, Char) | |
go [] = Nothing | |
go (x : xs) | |
| x == c = Just (xs, x) | |
| otherwise = Nothing | |
stringP :: String -> Parser String | |
stringP = traverse charP | |
spanP :: (Char -> Bool) -> Parser String | |
spanP f = Parser go | |
where | |
go :: String -> Maybe (String, String) | |
go (x : xs) | |
| f x = case go xs of | |
Nothing -> Just (xs, [x]) | |
Just (input, ys) -> Just (input, x : ys) | |
| otherwise = Nothing | |
go [] = Nothing | |
sepBy :: Parser () -> Parser a -> Parser [a] | |
sepBy sep value = | |
(:) <$> value <*> many (sep *> value) | |
<|> pure [] | |
stringLiteral :: Parser String | |
stringLiteral = charP '"' *> spanP (/= '"') <* charP '"' | |
ws :: Parser () | |
ws = () <$ spanP isSpace | |
comma :: Parser () | |
comma = () <$ charP ',' | |
jsonValue :: Parser JsonValue | |
jsonValue = | |
jsonNull | |
<|> jsonBool | |
<|> jsonNumber | |
<|> jsonString | |
<|> jsonArray | |
<|> jsonObject | |
jsonNull :: Parser JsonValue | |
jsonNull = JsonNull <$ stringP "null" | |
jsonBool :: Parser JsonValue | |
jsonBool = true <|> false | |
where | |
true = JsonBool True <$ stringP "true" | |
false = JsonBool False <$ stringP "false" | |
jsonNumber :: Parser JsonValue | |
jsonNumber = jsonFloat <|> jsonInteger | |
jsonInteger :: Parser JsonValue | |
jsonInteger = JsonInteger . read <$> spanP isDigit | |
jsonFloat :: Parser JsonValue | |
jsonFloat = JsonFloat <$> floatP | |
floatP :: Parser Float | |
floatP = toFloat <$> spanP isDigit <*> (charP '.' *> spanP isDigit) | |
where | |
toFloat :: String -> String -> Float | |
toFloat numerator denominator = read $ numerator ++ "." ++ denominator | |
jsonString :: Parser JsonValue | |
jsonString = JsonString <$> stringLiteral | |
jsonArray :: Parser JsonValue | |
jsonArray = JsonArray <$> (charP '[' *> elems <* charP ']') | |
where | |
elems :: Parser [JsonValue] | |
elems = sepBy comma (many ws *> jsonValue <* many ws) | |
jsonObject :: Parser JsonValue | |
jsonObject = JsonObject <$> (charP '{' *> pairs <* charP '}') | |
where | |
pairs :: Parser [(String, JsonValue)] | |
pairs = sepBy comma pair | |
pair :: Parser (String, JsonValue) | |
pair = | |
(,) | |
<$> (many ws *> stringLiteral <* many ws) | |
<*> (charP ':' *> (many ws *> jsonValue <* many ws)) | |
-- >>> runParser jsonValue "[123 , 123.3444, {}, {\"foo\":[null, false, 1.2, 123]} ]" | |
-- Just ("",JsonArray [JsonInteger 123,JsonFloat 123.3444,JsonObject [],JsonObject [("foo",JsonArray [JsonNull,JsonBool False,JsonFloat 1.2,JsonInteger 123])]]) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment