Created
January 13, 2018 21:53
-
-
Save king1600/abc1b686ef778f11ce04ceb96915adb8 to your computer and use it in GitHub Desktop.
A Basic Json Parser for practice
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
import Data.Map (Map) | |
import Text.Read (readMaybe) | |
import Data.List (isPrefixOf) | |
import qualified Data.Map as Map | |
import Data.Char (isSpace, isNumber, isAlpha) | |
data Json = | |
JNull | | |
JBool Bool | | |
JInt Integer | | |
JFloat Double | | |
JArray [Json] | | |
JString String | | |
JObject (Map String Json) | |
deriving Show | |
isNumeric :: Char -> Bool | |
isNumeric c = isNumber c || c `elem` "x." | |
parse :: String -> Json | |
parse str = parseJson str [] | |
where | |
parseJson :: String -> [Json] -> Json | |
parseJson str values = case parseItem str of | |
([], item) -> if null values then item else JArray $ reverse $ item : values | |
(remains, item) -> parseJson remains $ item : values | |
parseItem :: String -> (String, Json) | |
parseItem [] = ([], JNull) | |
parseItem str | |
| isSpace char = parseItem rest | |
| char == '"' = parseString rest | |
| char == '[' = parseArray rest [] | |
| isNumeric char = parseNumber str | |
| char == '{' = parseObject rest (Map.empty :: (Map String Json)) | |
| otherwise = parseAtom str | |
where char = head str | |
rest = tail str | |
parseString :: String -> (String, Json) | |
parseString str = parseWhile False (\c -> c /= '"') (\s -> JString s) str [] | |
parseNumber :: String -> (String, Json) | |
parseNumber str = parseWhile True (\c -> isNumeric c) (parseNumeric) str [] | |
parseWhile :: Bool -> (Char -> Bool) -> (String -> Json) -> String -> String -> (String, Json) | |
parseWhile hasLast check create [] value = ([], create $ reverse $ value) | |
parseWhile hasLast check create str value | |
| check char = parseWhile hasLast check create rest $ char : value | |
| otherwise = (if hasLast then str else rest, create $ reverse $ value) | |
where char = head str | |
rest = tail str | |
parseAtom :: String -> (String, Json) | |
parseAtom [] = ([], JNull) | |
parseAtom str | |
| isPrefixOf "null" str = (drop 4 str, JNull) | |
| isPrefixOf "true" str = (drop 4 str, JBool True) | |
| isPrefixOf "false" str = (drop 5 str, JBool False) | |
| otherwise = error $ "Invalid atom: " ++ take 16 str | |
parseArray :: String -> [Json] -> (String, Json) | |
parseArray [] value = ([], JArray $ reverse value) | |
parseArray str value | |
| char == ']' = (rest, JArray $ reverse value) | |
| isSpace char || char == ',' = parseArray rest value | |
| otherwise = | |
let (remaining, item) = parseItem str in | |
parseArray remaining $ item : value | |
where char = head str | |
rest = tail str | |
parseObject :: String -> (Map String Json) -> (String, Json) | |
parseObject [] obj = ([], JObject obj) | |
parseObject str obj | |
| char == '}' = (rest, JObject obj) | |
| isSpace char || char == ',' = parseObject rest obj | |
| otherwise = case parseItem str of | |
(after, JString key) -> | |
if null after || head after /= ':' | |
then error $ "Expected ':' after json key" | |
else let (remaining, value) = parseItem $ tail $ after in | |
parseObject remaining $ Map.insert key value obj | |
(after, k) -> error $ "Invalid json key for object: " ++ (show k) | |
where char = head str | |
rest = tail str | |
parseNumeric :: String -> Json | |
parseNumeric str | |
| 'e' `elem` str || '.' `elem` str = parseFloat str | |
| otherwise = parseInt str | |
where | |
parseInt :: String -> Json | |
parseInt str = case readMaybe str :: Maybe Integer of | |
Nothing -> parseFloat str | |
Just value -> JInt value | |
parseFloat :: String -> Json | |
parseFloat str = case readMaybe str :: Maybe Double of | |
Just value -> JFloat value | |
Nothing -> error $ "Invalid number literal: " ++ str |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment