Last active
June 19, 2023 07:57
-
-
Save fero23/51f63a33d733055d53b4 to your computer and use it in GitHub Desktop.
JSON Parser with Haskell's Parsec
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 Text.ParserCombinators.Parsec | |
import Data.List | |
type Args = [String] | |
type Body = [String] | |
type Label = String | |
data JSONProp = JSONProp Label JSON deriving Show | |
data JSON = JSONObject [JSONProp] | |
| JSONNumber Double | |
| JSONBool Bool | |
| JSONStr String | |
| JSONArray [JSON] | |
| JSONNull | |
deriving Show | |
eol = try (string "\n\r") | |
<|> try (string "\r\n") | |
<|> string "\n" | |
<|> string "\r" | |
<?> "EOL" | |
whitespace = skipMany space | |
parseObj = do | |
whitespace >> char '{' >> whitespace | |
props <- sepBy parseProps (whitespace >> char ',' >> whitespace) | |
whitespace >> char '}' >> whitespace | |
return $ JSONObject props | |
parseStr = between (char '\"') (char '\"') (many $ noneOf "\"" <|> try (string "\"\"" >> return '"')) | |
parseProps = do | |
label <- parseLabel | |
value <- (parseObj | |
<|> parseArray | |
<|> parseBoolean | |
<|> parseNull | |
<|> parseJSONStr | |
<|> parseNumber) | |
return $ JSONProp label value | |
parseLabel = do | |
whitespace | |
label <- parseStr | |
whitespace >> char ':' >> whitespace | |
return label | |
parseNumber = do | |
whitespace | |
digits <- many (digit <|> oneOf ".-") | |
whitespace | |
return . JSONNumber $ read digits | |
parseJSONStr = do | |
whitespace | |
str <- parseStr | |
whitespace | |
return $ JSONStr str | |
parseBoolean = do | |
whitespace | |
bool <- (string "true") <|> (string "false") | |
whitespace | |
return $ if bool == "true" then JSONBool True else JSONBool False | |
parseNull = do | |
whitespace >> string "null" >> whitespace | |
return JSONNull | |
parseArray = do | |
whitespace >> char '[' >> whitespace | |
array <- sepBy (parseObj | |
<|> parseArray | |
<|> parseBoolean | |
<|> parseNull | |
<|> parseJSONStr | |
<|> parseNumber) (whitespace >> char ',' >> whitespace) | |
whitespace >> char ']' >> whitespace | |
return $ JSONArray array | |
toJSON :: String -> String -> Either ParseError JSON | |
toJSON src text = parse (parseObj <|> parseArray) src text | |
getJSONFromFile :: String -> IO (Either ParseError JSON) | |
getJSONFromFile file = do | |
text <- readFile file | |
return $ toJSON file text | |
searchProperties :: String -> JSON -> JSON | |
searchProperties propName (JSONArray objs) = JSONArray $ map (searchProperties propName) objs | |
searchProperties propName (JSONObject props) = JSONObject $ searchN [] props | |
where | |
searchN acc [] = acc | |
searchN acc (n@(JSONProp label (JSONObject inner)):others) = | |
searchN [] inner ++ if label == propName then searchN (n:acc) others else searchN acc others | |
searchN acc (n@(JSONProp label _):others) = | |
if label == propName then searchN (n:acc) others else searchN acc others | |
updateProps :: String -> (JSON -> JSON) -> JSON -> JSON | |
updateProps propName f (JSONArray objs) = JSONArray $ map (updateProps propName f) objs | |
updateProps propName f (JSONObject props) = JSONObject $ updateN [] props | |
where | |
updateN acc [] = reverse acc | |
updateN acc (n@(JSONProp label obj):others) | |
| label == propName = updateN (JSONProp label (f obj) : acc) others | |
| otherwise = case obj of | |
JSONObject inner -> updateN ((JSONProp label . JSONObject $ updateN [] inner) : acc) others | |
otherwise -> updateN (n : acc) others | |
(!!) :: JSON -> String -> JSON | |
(JSONObject props) !! property = case filter (\(JSONProp label _ ) -> label == property) props of | |
[] -> JSONNull | |
(JSONProp label obj) : tail -> obj | |
toString :: JSON -> String | |
toString obj = toS 0 obj | |
where | |
ind i = replicate (i * 4) ' ' | |
propToS i (JSONProp label obj) = ind i ++ "\"" ++ label ++ "\": " ++ toS i obj | |
toS i (JSONObject props) = "{\n" ++ (intercalate ",\n" $ map (propToS $ i + 1) props) ++ "\n" ++ ind i ++ "}" | |
toS i (JSONArray objs) = "[" ++ (intercalate ", " $ map (toS $ i + 1) objs) ++ "\n" ++ ind i ++ "]" | |
toS i (JSONBool bool) = if bool then "true" else "false" | |
toS i (JSONStr str) = '"' : str ++ "\"" | |
toS i (JSONNumber n) = show n | |
toS i JSONNull = "null" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
In
parseNumber
many (digit <|> oneOf ".-")
would parse.-.---.
as a number, wouldn't it?