Skip to content

Instantly share code, notes, and snippets.

@king1600
Created January 13, 2018 21:53
Show Gist options
  • Save king1600/abc1b686ef778f11ce04ceb96915adb8 to your computer and use it in GitHub Desktop.
Save king1600/abc1b686ef778f11ce04ceb96915adb8 to your computer and use it in GitHub Desktop.
A Basic Json Parser for practice
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